util/mknum.pl

   1
   2 #! /usr/bin/env perl
   3 # Copyright 2018 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 $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;
  57     open IN, $f || die "Couldn't open $f: $!\n";
  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
  91 if ($checkexist) {
  92     my %new_names = map { $_->name() => 1 }
  93         $ordinals->items(comparator => sub { $_[0] cmp $_[1] },
  94                          filter => sub { $_->exists() });
  95     # Eliminate common names
  96     foreach (keys %orig_names) {
  97         next unless exists $new_names{$_};
  98         delete $orig_names{$_};
  99         delete $new_names{$_};
 100     }
 101     if (%orig_names) {
 102         print "The following symbols do not seem to exist in code:\n";
 103         foreach (sort keys %orig_names) {
 104             print "\t$_\n";
 105         }
 106     }
 107     if (%new_names) {
 108         print "The following existing symbols are not in ordinals file:\n";
 109         foreach (sort keys %new_names) {
 110             print "\t$_\n";
 111         }
 112     }
 113 } else {
 114     $ordinals->rewrite();
 115     my %stats = $ordinals->stats();
 116     print STDERR
 117         "${ordinals_file}: $stats{modified} old symbols have updated info\n"
 118         if $stats{modified};
 119     if ($stats{new}) {
 120         print STDERR "${ordinals_file}: Added $stats{new} new symbols\n";
 121     } else {
 122         print STDERR "${ordinals_file}: No new symbols added\n";
 123     }
 124
 125 }