Home | History | Annotate | Line # | Download | only in util 
      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 
     10 use strict;
     11 use warnings;
     12 
     13 use Getopt::Long;
     14 use FindBin;
     15 use lib "$FindBin::Bin/perl";
     16 
     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 $renumber = 0;
     26 my $verbose = 0;
     27 my $debug = 0;
     28 
     29 GetOptions('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 
     39 die "Please supply ordinals file\n"
     40     unless $ordinals_file;
     41 
     42 my $ordinals = OpenSSL::Ordinals->new(from => $ordinals_file,
     43                                       warnings => $warnings,
     44                                       verbose => $verbose,
     45                                       debug => $debug);
     46 $ordinals->set_version($version);
     47 
     48 my %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 
     57 foreach 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 
     95 if ($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