path: root/util/perl/OpenSSL/Ordinals.pm

#! /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

package OpenSSL::Ordinals;

use strict;
use warnings;
use Carp;
use Scalar::Util qw(blessed);

=head1 NAME

OpenSSL::Ordinals - a private module to read and walk through ordinals

=head1 SYNOPSIS

  use OpenSSL::Ordinals;

  my $ordinals = OpenSSL::Ordinals->new(from => "foo.num");
  # or alternatively
  my $ordinals = OpenSSL::Ordinals->new();
  $ordinals->load("foo.num");

  foreach ($ordinals->items(comparator => by_name()) {
    print $_->name(), "\n";
  }

=head1 DESCRIPTION

This is a OpenSSL private module to load an ordinals (F<.num>) file and
write out the data you want, sorted and filtered according to your rules.

An ordinals file is a file that enumerates all the symbols that a shared
library or loadable module must export.  Each of them have a unique
assigned number as well as other attributes to indicate if they only exist
on a subset of the supported platforms, or if they are specific to certain
features.

The unique numbers each symbol gets assigned needs to be maintained for a
shared library or module to stay compatible with previous versions on
platforms that maintain a transfer vector indexed by position rather than
by name.  They also help keep information on certain symbols that are
aliases for others for certain platforms, or that have different forms
on different platforms.

=head2 Main methods

=over  4

=cut

=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
options are:

=over 4

=item B<from =E<gt> FILENAME>

Not only create a new instance, but immediately load it with data from the
ordinals file FILENAME.

=back

=cut

sub new {
    my $class = shift;
    my %opts = @_;

    my $instance = {
        contents        => [],    # The items themselves
    };
    bless $instance, $class;

    $instance->load($opts{from}) if defined($opts{from});

    return $instance;
}

=item B<$ordinals-E<gt>load FILENAME>

Loads the data from FILENAME into the instance.  Any previously loaded data
is dropped.

=cut

sub load {
    my $self = shift;
    my $filename = shift;

    croak "Bad instance" unless blessed($self);
    croak "Undefined filename" unless defined($filename);

    my @tmp_contents;
    my $max_num = 0;
    open F, '<', $filename or croak "Unable to open $filename";
    while (<F>) {
        s|\R$||;                # Better chomp
        s|#.*||;
        next if /^\s*$/;

        my $item = OpenSSL::Ordinals::Item->new(from => $_);
        my $num = $item->number();

        croak "Disordered ordinals, $num < $max_num"
            if $num < $max_num;

        push @tmp_contents, $item;
    }
    close F;

    $self->{contents} = [ @tmp_contents ];
    return 1;
}

=item B<$ordinals-E<gt>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.
Available options are:

=over 4

=item B<sort =E<gt> 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>

FILTERFUNTION is a reference to a function that takes one argument, which
is every OpenSSL::Ordinals::Item element available.

=back

=cut

sub items {
    my $self = shift;
    my %opts = @_;

    my $comparator = $opts{sort};
    my $filter = $opts{filter} // sub { 1; };

    my @l = grep { $filter->($_) } @{$self->{contents}};
    return sort { $comparator->($a, $b); } @l
        if (defined $comparator);
    return @l;
}

=back

=head2 Data elements

Data elements, which is each line in an ordinals file, are instances
of a separate class, OpenSSL::Ordinals::Item, with its own methods:

=over 4

=cut

package OpenSSL::Ordinals::Item;

use strict;
use warnings;
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.
Available options are:

=over 4

=item B<from =E<gt> STRING>

MANDATORY OPTION!

This will create a new item, filled with data coming from STRING.

STRING must conform to the following EBNF description:

  ordinal string = symbol, spaces, ordinal, spaces, version, spaces,
                   exist, ":", platforms, ":", type, ":", features;
  spaces         = space, { space };
  space          = " " | "\t";
  symbol         = ( letter | "_"), { letter | digit | "_" };
  ordinal        = number;
  version        = number, "_", number, "_", number, letter, [ letter ];
  exist          = "EXIST" | "NOEXIST";
  platforms      = platform, { ",", platform };
  platform       = ( letter | "_" ) { letter | digit | "_" };
  type           = "FUNCTION" | "VARIABLE";
  features       = feature, { ",", feature };
  feature        = ( letter | "_" ) { letter | digit | "_" };
  number         = digit, { digit };

(C<letter> and C<digit> are assumed self evident)

=back

=cut

sub new {
    my $class = shift;
    my %opts = @_;

    my $string = $opts{from};

    croak "No ordinals string given" unless defined $string;

    my @a = split /\s+/, $string;

    croak "Badly formatted ordinals string: $string"
        unless ( scalar @a == 4
                 && $a[0] =~ /^[A-Za-z_][A-Za-z_0-9]*$/
                 && $a[1] =~ /^\d+$/
                 && $a[2] =~ /^\d+_\d+_\d+(?:[a-z]{0,2})$/
                 && $a[3] =~ /^
                              (?:NO)?EXIST:
                              [^:]*:
                              (?:FUNCTION|VARIABLE):
                              [^:]*
                              $
                             /x );

    my @b = split /:/, $a[3];
    my $instance = { name       => $a[0],
                     number     => $a[1],
                     version    => $a[2],
                     exists     => $b[0] eq 'EXIST',
                     platforms  => { map { m|^(!)?|; $' => !$1 }
                                         split /,/,$b[1] },
                     type       => $b[2],
                     features   => [ split /,/,$b[3] // '' ] };

    return bless $instance, $class;
}

sub DESTROY {
}

=item B<$item-E<gt>name>

The symbol name for this item.

=item B<$item-E<gt>number>

The positional number for this item.

=item B<$item-E<gt>version>

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>

A boolean that tells if this symbol exists in code or not.

=item B<$item-E<gt>platforms>

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>

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>

An array reference, where every item indicates a feature where this symbol
is available.  If no features are mentioned, the symbol is always available.
If any feature is mentioned, this symbol is I<only> available when those
features are enabled.

=cut

our $AUTOLOAD;

# Generic getter
sub AUTOLOAD {
    my $self = shift;
    my $funcname = $AUTOLOAD;
    (my $item = $funcname) =~ s|.*::||g;

    croak "$funcname called as setter" if @_;
    croak "$funcname invalid" unless exists $self->{$item};
    return $self->{$item} if ref($self->{$item}) eq '';
    return @{$self->{$item}} if ref($self->{$item}) eq 'ARRAY';
    return %{$self->{$item}} if ref($self->{$item}) eq 'HASH';
}

=item B<$item-E<gt>to_string>

Converts the item to a string that can be saved in an ordinals file.

=cut

sub to_string {
    my $self = shift;

    croak "Too many arguments" if @_;
    my %platforms = $self->platforms();
    my @features = $self->features();
    return sprintf "%-39s %d\t%s\t%s:%s:%s:%s",
        $self->name(),
        $self->number(),
        $self->version(),
        $self->exists() ? 'EXIST' : 'NOEXIST',
        join(',', (map { ($platforms{$_} ? '' : '!') . $_ }
                   sort keys %platforms)),
        $self->type(),
        join(',', @features);
}

=back

=head2 Comparators and filters

For the B<$ordinals-E<gt>items> method, there are a few functions to create
comparators based on specific data:

=over 4

=cut

# Go back to the main package to create comparators and filters
package OpenSSL::Ordinals;

# Comparators...

=item B<by_name>

Returns a comparator that will compare the names of two OpenSSL::Ordinals::Item
objects.

=cut

sub by_name {
    return sub { $_[0]->name() cmp $_[1]->name() };
}

=item B<by_number>

Returns a comparator that will compare the ordinal numbers of two
OpenSSL::Ordinals::Item objects.

=cut

sub by_number {
    return sub { $_[0]->number() <=> $_[1]->number() };
}

=item B<by_version>

Returns a comparator that will compare the version of two
OpenSSL::Ordinals::Item objects.

=cut

sub by_version {
    sub _ossl_versionsplit {
        my $textversion = shift;
        my ($major,$minor,$edit,$patch) =
            $textversion =~ /^(\d+)_(\d+)_(\d+)([a-z]{0,2})$/;
        return ($major,$minor,$edit,$patch);
    }

    return sub {
        my @a_split = _ossl_versionsplit($_[0]->version());
        my @b_split = _ossl_versionsplit($_[1]->