mknum.pl 5.0 KB

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