Hakase/openssl-custom
1
0 Fork 0
Code Issues Pull Requests Releases Wiki Activity

Latest update.

Browse Source
This commit is contained in:
Hakase
2020-01-17 19:45:12 +09:00
parent 016df9f433
commit 0f7abb4eb6
1100 changed files with 47785 additions and 16292 deletions
Download Patch File Download Diff File Expand all files Collapse all files
util/perl/OpenSSL/Ordinals.pm
+125 -51
View File
@@ -64,12 +64,12 @@ on different platforms.
=item B<new> I<%options>
Creates a new instance of the C<OpenSSL::Ordinals> class. It takes options
in keyed pair form, i.e. a series of C<key =E<gt> value> pairs. Available
in keyed pair form, i.e. a series of C<< key => value >> pairs. Available
options are:
=over 4
=item B<from =E<gt> FILENAME>
=item B<< from => FILENAME >>
Not only create a new instance, but immediately load it with data from the
ordinals file FILENAME.
@@ -86,6 +86,7 @@ sub new {
filename => undef, # File name registered when loading
loaded_maxnum => 0, # Highest allocated item number when loading
loaded_contents => [], # Loaded items, if loading there was
maxassigned => 0, # Current highest assigned item number
maxnum => 0, # Current highest allocated item number
contents => [], # Items, indexed by number
name2num => {}, # Name to number dictionary
@@ -101,7 +102,7 @@ sub new {
return $instance;
}
=item B<$ordinals-E<gt>load FILENAME>
=item B<< $ordinals->load FILENAME >>
Loads the data from FILENAME into the instance. Any previously loaded data
is dropped.
@@ -121,6 +122,7 @@ sub load {
my @tmp_contents = ();
my %tmp_name2num = ();
my $max_assigned = 0;
my $max_num = 0;
open F, '<', $filename or croak "Unable to open $filename";
while (<F>) {
@@ -131,17 +133,27 @@ sub load {
my $item = OpenSSL::Ordinals::Item->new(from => $_);
my $num = $item->number();
croak "Disordered ordinals, $num < $max_num"
if $num < $max_num;
$max_num = $num;
if ($num eq '?') {
$num = ++$max_num;
} elsif ($num eq '?+') {
$num = $max_num;
} else {
croak "Disordered ordinals, number sequence restarted"
if $max_num > $max_assigned && $num < $max_num;
croak "Disordered ordinals, $num < $max_num"
if $num < $max_num;
$max_assigned = $max_num = $num;
}
push @{$tmp_contents[$item->number()]}, $item;
$tmp_name2num{$item->name()} = $item->number();
$item->intnum($num);
push @{$tmp_contents[$num]}, $item;
$tmp_name2num{$item->name()} = $num;
}
close F;
$self->{contents} = [ @tmp_contents ];
$self->{name2num} = { %tmp_name2num };
$self->{maxassigned} = $max_assigned;
$self->{maxnum} = $max_num;
$self->{filename} = $filename;
@@ -157,7 +169,26 @@ sub load {
return 1;
}
=item B<$ordinals-E<gt>rewrite>
=item B<< $ordinals->renumber >>
Renumber any item that doesn't have an assigned number yet.
=cut
sub renumber {
my $self = shift;
my $max_assigned = 0;
foreach ($self->items(by => by_number())) {
$_->number($_->intnum()) if $_->number() =~ m|^\?|;
if ($max_assigned < $_->number()) {
$max_assigned = $_->number();
}
}
$self->{maxassigned} = $max_assigned;
}
=item B<< $ordinals->rewrite >>
If an ordinals file has been loaded, it gets rewritten with the data from
the current work database.
@@ -170,10 +201,10 @@ sub rewrite {
$self->write($self->{filename});
}
=item B<$ordinals-E<gt>write FILENAME>
=item B<< $ordinals->write FILENAME >>
Writes the current work database data to the ordinals file FILENAME.
This also validates the data, see B<$ordinals-E<gt>validate> below.
This also validates the data, see B<< $ordinals->validate >> below.
=cut
@@ -195,23 +226,23 @@ sub write {
return 1;
}
=item B<$ordinals-E<gt>items> I<%options>
=item B<< $ordinals->items >> I<%options>
Returns a list of items according to a set of criteria. The criteria is
given in form keyed pair form, i.e. a series of C<key =E<gt> value> pairs.
given in form keyed pair form, i.e. a series of C<< key => value >> pairs.
Available options are:
=over 4
=item B<sort =E<gt> SORTFUNCTION>
=item B<< sort => SORTFUNCTION >>
SORTFUNCTION is a reference to a function that takes two arguments, which
correspond to the classic C<$a> and C<$b> that are available in a C<sort>
block.
=item B<filter =E<gt> FILTERFUNCTION>
=item B<< filter => FILTERFUNCTION >>
FILTERFUNTION is a reference to a function that takes one argument, which
FILTERFUNCTION is a reference to a function that takes one argument, which
is every OpenSSL::Ordinals::Item element available.
=back
@@ -271,7 +302,7 @@ sub _putback {
my %versions = ();
my %features = ();
foreach (@items) {
$numbers{$_->number()} = 1;
$numbers{$_->intnum()} = 1;
$versions{$_->version()} = 1;
foreach ($_->features()) {
$features{$_}++;
@@ -280,7 +311,7 @@ sub _putback {
# Check that all items we're trying to put back have the same number
croak "Items don't have the same numeral: ",
join(", ", map { $_->name()." => ".$_->number() } @items), "\n"
join(", ", map { $_->name()." => ".$_->intnum() } @items), "\n"
if (scalar keys %numbers > 1);
croak "Items don't have the same version: ",
join(", ", map { $_->name()." => ".$_->version() } @items), "\n"
@@ -323,7 +354,7 @@ sub _putback {
$items[0]->name(), " and ", $items[1]->name(), "\n";
}
}
$self->{contents}->[$items[0]->number()] = [ @items ];
$self->{contents}->[$items[0]->intnum()] = [ @items ];
}
sub _parse_platforms {
@@ -379,7 +410,7 @@ sub _adjust_version {
return $version;
}
=item B<$ordinals-E<gt>add NAME, TYPE, LIST>
=item B<< $ordinals->add NAME, TYPE, LIST >>
Adds a new item named NAME with the type TYPE, and a set of C macros in
LIST that are expected to be defined or undefined to use this symbol, if
@@ -387,9 +418,7 @@ any. For undefined macros, they each must be prefixed with a C<!>.
If this symbol already exists in loaded data, it will be rewritten using
the new input data, but will keep the same ordinal number and version.
If it's entirely new, it will get a new number and the current default
version. The new ordinal number is a simple increment from the last
maximum number.
If it's entirely new, it will get a '?' and the current default version.
=cut
@@ -411,7 +440,8 @@ sub add {
my @items = $self->items(filter => f_name($name));
my $version = @items ? $items[0]->version() : $self->{currversion};
my $number = @items ? $items[0]->number() : ++$self->{maxnum};
my $intnum = @items ? $items[0]->intnum() : ++$self->{maxnum};
my $number = @items ? $items[0]->number() : '?';
print STDERR "DEBUG[",__PACKAGE__,":add] $verbsig\n",
@items ? map { "\t".$_->to_string()."\n" } @items : "No previous items\n",
if $self->{debug};
@@ -421,6 +451,7 @@ sub add {
OpenSSL::Ordinals::Item->new( name => $name,
type => $type,
number => $number,
intnum => $intnum,
version =>
$self->_adjust_version($version),
exists => 1,
@@ -445,7 +476,7 @@ sub add {
return @returns;
}
=item B<$ordinals-E<gt>add_alias ALIAS, NAME, LIST>
=item B<< $ordinals->add_alias ALIAS, NAME, LIST >>
Adds an alias ALIAS for the symbol NAME, and a set of C macros in LIST
that are expected to be defined or undefined to use this symbol, if any.
@@ -505,10 +536,13 @@ sub add_alias {
# We supposedly do now know how to do this... *ahem*
$items[0]->{platforms} = { %alias_platforms };
my $number =
$items[0]->number() =~ m|^\?| ? '?+' : $items[0]->number();
my $alias_item = OpenSSL::Ordinals::Item->new(
name => $alias,
type => $items[0]->type(),
number => $items[0]->number(),
number => $number,
intnum => $items[0]->intnum(),
version => $self->_adjust_version($items[0]->version()),
exists => $items[0]->exists(),
platforms => { %platforms },
@@ -528,9 +562,9 @@ sub add_alias {
"\t", join(", ", map { $_->name() } @items), "\n";
}
=item B<$ordinals-E<gt>set_version VERSION>
=item B<< $ordinals->set_version VERSION >>
=item B<$ordinals-E<gt>set_version VERSION BASEVERSION>
=item B<< $ordinals->set_version VERSION BASEVERSION >>
Sets the default version for new symbol to VERSION.
@@ -591,7 +625,7 @@ sub set_version {
return 1;
}
=item B<$ordinals-E<gt>invalidate>
=item B<< $ordinals->invalidate >>
Invalidates the whole working database. The practical effect is that all
symbols are set to not exist, but are kept around in the database to retain
@@ -610,11 +644,11 @@ sub invalidate {
$self->{stats} = {};
}
=item B<$ordinals-E<gt>validate>
=item B<< $ordinals->validate >>
Validates the current working database by collection statistics on how many
symbols were added and how many were changed. These numbers can be retrieved
with B<$ordinals-E<gt>stats>.
with B<< $ordinals->stats >>.
=cut
@@ -628,6 +662,11 @@ sub validate {
&& @{$self->{contents}->[$i] // []})) {
$self->{stats}->{new}++;
}
if ($i <= $self->{maxassigned}) {
$self->{stats}->{assigned}++;
} else {
$self->{stats}->{unassigned}++;
}
next if ($i > $self->{loaded_maxnum});
my @loaded_strings =
@@ -644,7 +683,7 @@ sub validate {
}
}
=item B<$ordinals-E<gt>stats>
=item B<< $ordinals->stats >>
Returns the statistics that B<validate> calculate.
@@ -676,12 +715,12 @@ use Carp;
=item B<new> I<%options>
Creates a new instance of the C<OpenSSL::Ordinals::Item> class. It takes
options in keyed pair form, i.e. a series of C<key =E<gt> value> pairs.
options in keyed pair form, i.e. a series of C<< key => value >> pairs.
Available options are:
=over 4
=item B<from =E<gt> STRING>
=item B<< from => STRING >>
This will create a new item, filled with data coming from STRING.
@@ -691,8 +730,8 @@ STRING must conform to the following EBNF description:
exist, ":", platforms, ":", type, ":", features;
spaces = space, { space };
space = " " | "\t";
symbol = ( letter | "_"), { letter | digit | "_" };
ordinal = number;
symbol = ( letter | "_" ), { letter | digit | "_" };
ordinal = number | "?" | "?+";
version = number, "_", number, "_", number, [ letter, [ letter ] ];
exist = "EXIST" | "NOEXIST";
platforms = platform, { ",", platform };
@@ -704,9 +743,9 @@ STRING must conform to the following EBNF description:
(C<letter> and C<digit> are assumed self evident)
=item B<name =E<gt> STRING>, B<number =E<gt> NUMBER>, B<version =E<gt> STRING>,
B<exists =E<gt> BOOLEAN>, B<type =E<gt> STRING>,
B<platforms =E<gt> HASHref>, B<features =E<gt> LISTref>
=item B<< name => STRING >>, B<< number => NUMBER >>, B<< version => STRING >>,
B<< exists => BOOLEAN >>, B<< type => STRING >>,
B<< platforms => HASHref >>, B<< features => LISTref >>
This will create a new item with data coming from the arguments.
@@ -732,7 +771,7 @@ sub new {
croak "Badly formatted ordinals string: $opts{from}"
unless ( scalar @a == 4
&& $a[0] =~ /^[A-Za-z_][A-Za-z_0-9]*$/
&& $a[1] =~ /^\d+$/
&& $a[1] =~ /^\d+|\?\+?$/
&& $a[2] =~ /^(?:\*|\d+_\d+_\d+[a-z]{0,2})$/
&& $a[3] =~ /^
(?:NO)?EXIST:
@@ -762,6 +801,7 @@ sub new {
$instance = { name => $opts{name},
type => $opts{type},
number => $opts{number},
intnum => $opts{intnum},
version => $version,
exists => !!$opts{exists},
platforms => { %{$opts{platforms} // {}} },
@@ -777,36 +817,40 @@ sub new {
sub DESTROY {
}
=item B<$item-E<gt>name>
=item B<< $item->name >>
The symbol name for this item.
=item B<$item-E<gt>number>
=item B<< $item->number >> (read-write)
The positional number for this item.
=item B<$item-E<gt>version>
This may be '?' for an unassigned symbol, or '?+' for an unassigned symbol
that's an alias for the previous symbol. '?' and '?+' must be properly
handled by the caller. The caller may change this to an actual number.
=item B<< $item->version >> (read-only)
The version number for this item. Please note that these version numbers
have underscore (C<_>) as a separator the the version parts.
=item B<$item-E<gt>exists>
=item B<< $item->exists >> (read-only)
A boolean that tells if this symbol exists in code or not.
=item B<$item-E<gt>platforms>
=item B<< $item->platforms >> (read-only)
A hash table reference. The keys of the hash table are the names of
the specified platforms, with a value of 0 to indicate that this symbol
isn't available on that platform, and 1 to indicate that it is. Platforms
that aren't mentioned default to 1.
=item B<$item-E<gt>type>
=item B<< $item->type >> (read-only)
C<FUNCTION> or C<VARIABLE>, depending on what the symbol represents.
Some platforms do not care about this, others do.
=item B<$item-E<gt>features>
=item B<< $item->features >> (read-only)
An array reference, where every item indicates a feature where this symbol
is available. If no features are mentioned, the symbol is always available.
@@ -830,7 +874,37 @@ sub AUTOLOAD {
return %{$self->{$item}} if ref($self->{$item}) eq 'HASH';
}
=item B<$item-E<gt>to_string>
=item B<< $item->intnum >> (read-write)
Internal positional number. If I<< $item->number >> is '?' or '?+', the
caller can use this to set a number for its purposes.
If I<< $item->number >> is a number, I<< $item->intnum >> should be the
same
=cut
# Getter/setters
sub intnum {
my $self = shift;
my $value = shift;
my $item = 'intnum';
croak "$item called with extra arguments" if @_;
$self->{$item} = "$value" if defined $value;
return $self->{$item};
}
sub number {
my $self = shift;
my $value = shift;
my $item = 'number';
croak "$item called with extra arguments" if @_;
$self->{$item} = "$value" if defined $value;
return $self->{$item};
}
=item B<< $item->to_string >>
Converts the item to a string that can be saved in an ordinals file.
@@ -844,7 +918,7 @@ sub to_string {
my @features = $self->features();
my $version = $self->version();
$version =~ s|\.|_|g;
return sprintf "%-39s %d\t%s\t%s:%s:%s:%s",
return sprintf "%-39s %s\t%s\t%s:%s:%s:%s",
$self->name(),
$self->number(),
$version,
@@ -859,7 +933,7 @@ sub to_string {
=head2 Comparators and filters
For the B<$ordinals-E<gt>items> method, there are a few functions to create
For the B<< $ordinals->items >> method, there are a few functions to create
comparators based on specific data:
=over 4
@@ -890,7 +964,7 @@ OpenSSL::Ordinals::Item objects.
=cut
sub by_number {
return sub { $_[0]->number() <=> $_[1]->number() };
return sub { $_[0]->intnum() <=> $_[1]->intnum() };
}
=item B<by_version>
util/perl/OpenSSL/ParseC.pm
+8 -30
View File
@@ -65,11 +65,14 @@ my @opensslcpphandlers = (
# These are used to convert certain pre-precessor expressions into
# others that @cpphandlers have a better chance to understand.
{ regexp => qr/#if (!?)OPENSSL_API_([0-9_]+)$/,
# This changes any OPENSSL_NO_DEPRECATED_x_y[_z] check to a check of
# OPENSSL_NO_DEPRECATEDIN_x_y[_z]. That's due to <openssl/macros.h>
# creating OPENSSL_NO_DEPRECATED_x_y[_z], but the ordinals files using
# DEPRECATEDIN_x_y[_z].
{ regexp => qr/#if(def|ndef) OPENSSL_NO_DEPRECATED_(\d+_\d+(?:_\d+)?)$/,
massager => sub {
my $cnd = $1 eq '!' ? 'ndef' : 'def';
return (<<"EOF");
#if$cnd DEPRECATEDIN_$2
#if$1 OPENSSL_NO_DEPRECATEDIN_$2
EOF
}
}
@@ -261,7 +264,7 @@ my @opensslchandlers = (
# We trick the parser by pretending that the declaration is wrapped in a
# check if the DEPRECATEDIN macro is defined or not. Callers of parse()
# will have to decide what to do with it.
{ regexp => qr/(DEPRECATEDIN_\d+(?:_\d+_\d+)?)<<<\((.*)\)>>>/,
{ regexp => qr/(DEPRECATEDIN_\d+_\d+(?:_\d+)?)<<<\((.*)\)>>>/,
massager => sub { return (<<"EOF");
#ifndef $1
$2;
@@ -369,34 +372,9 @@ EOF
{ regexp => qr/DEFINE_STACK_OF_CONST<<<\((.*)\)>>>/,
massager => sub { return ("SKM_DEFINE_STACK_OF($1,const $1,$1)"); },
},
{ regexp => qr/PREDECLARE_STACK_OF<<<\((.*)\)>>>/,
massager => sub { return ("STACK_OF($1);"); }
},
{ regexp => qr/DECLARE_STACK_OF<<<\((.*)\)>>>/,
massager => sub { return ("STACK_OF($1);"); }
},
{ regexp => qr/DECLARE_SPECIAL_STACK_OF<<<\((.*?),\s*(.*?)\)>>>/,
massager => sub { return ("STACK_OF($1);"); }
},
#####
# ASN1 stuff
{ regexp => qr/TYPEDEF_D2I_OF<<<\((.*)\)>>>/,
massager => sub {
return ("typedef $1 *d2i_of_$1($1 **,const unsigned char **,long)");
},
},
{ regexp => qr/TYPEDEF_I2D_OF<<<\((.*)\)>>>/,
massager => sub {
return ("typedef $1 *i2d_of_$1($1 *,unsigned char **)");
},
},
{ regexp => qr/TYPEDEF_D2I2D_OF<<<\((.*)\)>>>/,
massager => sub {
return ("TYPEDEF_D2I_OF($1); TYPEDEF_I2D_OF($1)");
},
},
{ regexp => qr/DECLARE_ASN1_ITEM<<<\((.*)\)>>>/,
massager => sub {
return (<<"EOF");
@@ -558,7 +536,7 @@ my @chandlers = (
# Note that the main parse function has a special hack for 'extern "C" {'
# which can't be done in handlers
# We simply ignore it.
{ regexp => qr/extern "C" (.*;)/,
{ regexp => qr/^extern "C" (.*(?:;|>>>))/,
massager => sub { return ($1); },
},
# any other extern is just ignored
util/perl/OpenSSL/Util/Pod.pm
+48 -6
View File
@@ -82,6 +82,10 @@ was given as input.
All the names extracted from the NAME section.
=item B<contents =E<gt> "...">
The whole contents of the .pod file.
=back
=back
@@ -94,18 +98,36 @@ sub extract_pod_info {
my %defaults = ( debug => 0, section => 0, %$defaults_ref );
my $fh = undef;
my $filename = undef;
my $contents;
# If not a file handle, then it's assume to be a file path (a string)
unless (ref $input eq "GLOB") {
if (ref $input eq "") {
$filename = $input;
open $fh, $input or die "Trying to read $filename: $!\n";
print STDERR "DEBUG: Reading $input\n" if $defaults{debug};
$input = $fh;
}
if (ref $input eq "GLOB") {
local $/ = undef;
$contents = <$input>;
} else {
die "Unknown input type";
}
my @invisible_names = ();
my %podinfo = ( section => $defaults{section});
while(<$input>) {
s|\R$||;
# Regexp to split a text into paragraphs found at
# https://www.perlmonks.org/?node_id=584367
# Most of all, \G (continue at last match end) and /g (anchor
# this match for \G) are significant
foreach (map { /\G((?:(?!\n\n).)*\n+|.+\z)/sg } $contents) {
# Remove as many line endings as possible from the end of the paragraph
while (s|\R$||) {}
print STDERR "DEBUG: Paragraph:\n$_\n"
if $defaults{debug};
# Stop reading when we have reached past the NAME section.
last if (m|^=head1|
&& defined $podinfo{lastsect}
@@ -122,6 +144,16 @@ sub extract_pod_info {
$podinfo{lastsecttext} = "";
}
# Add invisible names
if (m|^=for\s+openssl\s+names:\s*(.*)|s) {
my $x = $1;
my @tmp = map { map { s/\s+//g; $_ } split(/,/, $_) } $x;
print STDERR
"DEBUG: Found invisible names: ", join(', ', @tmp), "\n"
if $defaults{debug};
push @invisible_names, @tmp;
}
next if (m|^=| || m|^\s*$|);
# Collect the section text
@@ -137,13 +169,23 @@ sub extract_pod_info {
print STDERR "DEBUG: Done reading $filename\n" if $defaults{debug};
}
$podinfo{lastsecttext} =~ s| - .*$||;
$podinfo{lastsecttext} =~ s|\s+-\s+.*$||s;
my @names =
map { s|\s+||g; s|/|-|g; $_ }
map { s/^\s+//g; # Trim prefix blanks
s/\s+$//g; # Trim suffix blanks
s|/|-|g; # Treat slash as dash
$_ }
split(m|,|, $podinfo{lastsecttext});
return ( section => $podinfo{section}, names => [ @names ] );
print STDERR
"DEBUG: Collected names are: ",
join(', ', @names, @invisible_names), "\n"
if $defaults{debug};
return ( section => $podinfo{section},
names => [ @names, @invisible_names ],
contents => $contents );
}
1;