path: root/helper_script/update-exported-constants

#!/usr/bin/env perl

use 5.008001;
use strict;
use warnings;

use Cwd qw(abs_path);
use English qw(
    $EVAL_ERROR $EXCEPTIONS_BEING_CAUGHT $OS_ERROR $RS -no_match_vars
);
use Fcntl qw(SEEK_SET);
use File::Basename qw(dirname);
use File::Spec::Functions qw(catfile);
use Getopt::Long qw(GetOptionsFromArray);
use POSIX qw(ceil);

our $VERSION = '1.93_03';

local $SIG{__DIE__} = sub {
    my ($cause) = @_;

    if ($EXCEPTIONS_BEING_CAUGHT) {
        return;
    }

    print STDERR $cause, "\n";

    exit 1;
};

my ($args) = eval { parse_options(\@ARGV) }
    or fatal( 'Failed to parse command line options', $EVAL_ERROR );

my @constants = eval { load_config( $args->{config} ) }
    or fatal( 'Failed to load configuration file', $EVAL_ERROR );

my @perl_constants = sort map { $_->{exported_name} } @constants;

eval { generate_constants_c( $args->{'constants-file'}, @constants ) }
    or fatal( 'Failed to generate constants file', $EVAL_ERROR );

eval { generate_constants_test( $args->{'test-file'}, @perl_constants ) }
    or fatal( 'Failed to generate constants test script', $EVAL_ERROR );

eval { update_module( $args->{'module-file'}, @perl_constants ) }
    or fatal( 'Failed to update Net::SSLeay module file', $EVAL_ERROR );

eval { update_pod( $args->{'pod-file'}, @perl_constants ) }
    or fatal( 'Failed to update Pod file', $EVAL_ERROR );


sub dist_file {
    my @path = @_;

    return abs_path( catfile( dirname(__FILE__), '..', @path ) );
}

sub parse_options {
    my ($argv) = @_;

    my $opts = {
        'config'         => dist_file( qw( helper_script constants.txt ) ),
        'constants-file' => dist_file( qw( constants.c ) ),
        'module-file'    => dist_file( qw( lib Net SSLeay.pm ) ),
        'pod-file'       => dist_file( qw( lib Net SSLeay.pod ) ),
        'test-file'      => dist_file( qw( t local 21_constants.t ) ),
    };

    GetOptionsFromArray(
        $argv,
        $opts,
        'config|C=s',
        'constants-file|c=s',
        'module-file|m=s',
        'pod-file|p=s',
        'test-file|t=s',
    );

    if ( !-e $opts->{'config'} ) {
        fatal("configuration file $opts->{config} does not exist");
    }

    if ( !-e $opts->{'module-file'} ) {
        fatal("Net::SSLeay module file $opts->{'module-file'} does not exist");
    }

    if ( !-e $opts->{'pod-file'} ) {
        fatal("Pod file $opts->{'pod-file'} does not exist");
    }

    return   wantarray
           ? ( $opts, $argv )
           : $opts;
}

sub load_config {
    my ($config_file) = @_;

    open my $fh, '<', $config_file
        or fatal( $config_file, $OS_ERROR );

    my @constants;
    my $line_number = 0;

    while (<$fh>) {
        $line_number++;

        # Trim leading and trailing space
        s{^\s+|\s+$}{}g;

        # Skip empty lines and comments
        next if m{^(?:\#.*)?$};

        # Check whether the given constant name is likely to be a valid
        # OpenSSL/LibreSSL constant name
        if ( $_ !~ m{^[A-Za-z_][A-Za-z0-9_]*$} ) {
            printf STDERR "%s:%d: badly-formatted constant name; skipping\n",
                $config_file, $line_number;

            next;
        }

        # Remove "SSL_" prefix from constant name, if present
        ( my $exported_name = $_ ) =~ s{^SSL_}{};

        push @constants, {
            exported_name => $exported_name,
            name          => $_,
        };
    }

    close $fh;

    return @constants;
}

sub generate_constants_c {
    my ( $file, @constants ) = @_;

    open my $fh, '>', $file
        or fatal($OS_ERROR);

    print $fh data_section('constants_c_header');
    print $fh Net::SSLeay::ConstantsGenerator->C_constant(
        {
            breakout => ~0,
            indent   => 20,
        },
        map {
            {
                name  => $_->{exported_name},
                value => $_->{name},
            }
        }
        (
            # This constant name isn't defined by any libssl implementation - it
            # is only intended to be used by the test script generated by this
            # script to ensure that Net::SSLeay behaves as expected when a
            # caller attempts to refer to an undefined constant
            {
                exported_name => '_NET_SSLEAY_TEST_UNDEFINED_CONSTANT',
                name =>          '_NET_SSLEAY_TEST_UNDEFINED_CONSTANT',
            },
            @constants,
        )
    );

    close $fh;

    printf "%s: generated\n", $file;

    return 1;
}

sub generate_constants_test {
    my ( $file, @constants ) = @_;

    open my $fh, '>', $file
        or fatal($OS_ERROR);

    print $fh data_section(
        'constants_test',
        {
            constants => join( "\n", map { q{ } x 4 . $_ } @constants ),
            # 1 dies_like() test for each constant
            # 1 is() test for @EXPORT_OK
            # 1 dies_like() test for undefined constant
            tests => @constants + 2,
        }
    );

    close $fh;

    printf "%s: generated\n", $file;

    return 1;
}

sub update_content {
    my ( $file, $start_match, $end_match, @replacement ) = @_;

    open my $fh, '<', $file
        or fatal($OS_ERROR);

    my ( @file, $start, $end );

    my $pos = 0;
    while (<$fh>) {
        push @file, $_;

        if ( !defined $start && $_ =~ $start_match ) {
            $start = $pos;
        }
        elsif ( defined $start && !defined $end && $_ =~ $end_match ) {
            $end = $pos;
        }

        $pos++;
    }

    close $fh;

    if ( !defined $start || !defined $end ) {
        fatal('could not find start/end markers');
    }

    splice @file, $start + 1, max( 0, $end - $start - 1 ), @replacement;

    open $fh, '>', $file
        or fatal($OS_ERROR);

    for (@file) {
        print $fh $_;
    }

    close $fh;

    return 1;
}

sub update_module {
    my ( $file, @constants ) = @_;

    eval {
        update_content(
            $file,
            qr{^my \@constants = qw\(},
            qr{^\);},
            map { q{ } x 4 . "$_\n" } @constants
        )
    } or do {
        ( my $err = $EVAL_ERROR ) =~ s{start/end markers$}{\@constants declaration};
        fatal( $file, $err );
    };

    printf "%s: updated\n", $file;

    return 1;
}

sub format_constants {
    my ( $list, $indent, $columns, $separator ) = @_;

    my $per_column = ceil( @$list / $columns );

    my @columns = map
        { [ splice @$list, 0, $per_column ] }
        ( 0 .. $columns - 1 );

    my @max_length = map
        { max( map { length } @$_ ) }
        @columns;

    my @formatted;
    for my $row ( 0 .. $per_column - 1 ) {
        my @row;
        for ( 0 .. $columns - 1 ) {
            my $this = $columns[$_]->[$row];
            my $left = $columns[ $_ - 1 ]->[$row];

            next if !defined $this;

            my $gap =   $_ == 0
                      ? $indent
                      : $max_length[ $_ - 1 ] - length($left) + $separator;

            push @row, q{ } x $gap . $this;
        }
        push @formatted, join( '', @row ) . "\n";
    }

    return @formatted;
}

sub update_pod {
    my ( $file, @constants ) = @_;

    eval {
        update_content(
            $file,
            qr{^=for start_constants$},
            qr{^=for end_constants$},
            ( "\n", format_constants( \@constants, 4, 2, 2 ), "\n" )
        )
    } or do {
        ( my $err = $EVAL_ERROR ) =~ s{start/end markers$}{constants block};
        fatal( $file, $err );
    };

    printf "%s: updated\n", $file;

    return 1;
}

sub max {
    my @numbers = @_;

    my $max = shift @numbers;
    while ( defined( my $number = shift @numbers ) ) {
        $max = $number if $number > $max;
    }

    return $max;
}

sub data_section {
    my ( $section, $tmpl ) = @_;

    seek DATA, 0, SEEK_SET;

    my @content = ();
    my $in_section;

    for (<DATA>) {
        if ( my ($name) = $_ =~ m{^\[section:(\w+)\]\n} ) {
            if ( $name eq $section ) {
                $in_section = 1;
                next;
            }
            elsif ($in_section) {
                # Reached the section following the requested section
                last;
            }
        }

        if ($in_section) {
            s/\{\{\s*(\w+)\s*\}\}/defined $tmpl->{$1} ? $tmpl->{$1} : ''/eg;
            push @content, $_;
        }
    }

    fatal("__DATA__ section '$section' not found")
        if !$in_section;

    return join '', @content;
}

sub fatal {
    my ( $message, $cause ) = @_;

    die Error->new( $message, $cause );
}

package Net::SSLeay::ConstantsGenerator;

use base 'ExtUtils::Constant::Base';

sub assignment_clause_for_type {
    my ( $self, $args, $value ) = @_;

    return main::data_section(
        'assignment_clause_for_type',
        {
            value => $value,
        }
    );
}

sub C_constant_return_type {
    my $ret = <<'END';
#ifdef NET_SSLEAY_32BIT_CONSTANTS
static double
#else
static uint64_t
#endif
END
    # Newline is automatically added, remove ours.
    chomp($ret);
    return $ret;
}

sub return_statement_for_notfound {
    return main::data_section('return_statement_for_notfound');
}

package Error;

use overload (
    q{""} => sub {
        my ($self) = @_;

        return   defined $self->{cause}
               ? "$self->{message}: $self->{cause}"
               : $self->{message};
    },
    fallback => 1,
);

sub new {
    my ( $class, $message, $cause ) = @_;

    return bless {
        message => $message,
        cause   => $cause,
    }, $class;
}

package main;

=pod

=encoding utf-8

=head1 NAME

C<update-exported-constants> - Manage constants exported by Net::SSLeay

=head1 VERSION

This document describes version 1.93_03 of C<update-exported-constants>.

=head1 USAGE

    # Edit constants.txt to add or remove a libssl/libcrypto constant

    # Export the new list of constants in Net::SSLeay, document them, and test
    # for their availability in the test suite:
    update-exported-constants

=head1 DESCRIPTION

Net::SSLeay exports a number of constants defined by libssl and libcrypto.
Several time-consuming and error-prone steps must be performed whenever this set
of constants changes: each one must be recognised as a valid constant name by
Net::SSLeay's XS code, defined as an exportable symbol in Net::SSLeay's Perl
code, documented in Net::SSLeay's user documentation, and tested in the
Net::SSLeay test suite to ensure that referencing it either returns a defined
value or raises an exception depending on whether it is defined in the version
of OpenSSL or LibreSSL being used.

C<update-exported-constants> simplifies the process of changing the set of
exportable constants by automating it: it consumes a configuration file
containing a list of constants, and performs each of the steps above for each of
the constants listed in the file.

=head1 DEPENDENCIES

C<update-exported-constants> requires Perl 5.8.1 or higher.

=head1 OPTIONS

C<update-exported-constants> accepts the following command line options:

=over 4

=item *

B<-C I<FILE>>, B<--config=I<FILE>>: the path to a file defining the libssl and
libcrypto constants that Net::SSLeay should attempt to export. See
L</CONFIGURATION> for a description of the expected format. Defaults to
C<constants.txt>, relative to the path to C<update-exported-constants>.

=item *

B<-c I<FILE>>, B<--constants-file=I<FILE>>: the path at which to write the C
source file defining the C<constant> function; this file should be included by
C<SSLeay.xs>. If a file exists at the given path, it will be overwritten.
Defaults to C<../constants.c>, relative to the path to
C<update-exported-constants>.

=item *

B<-m I<FILE>>, B<--module-file=I<FILE>>: the path to Net::SSLeay's source code;
the value of the C<@constants> array defined in this file will be overwritten.
Defaults to C<../lib/Net/SSLeay.pm>, relative to the path to
C<update-exported-constants>.

=item *

B<-p I<FILE>>, B<--pod-file=I<FILE>>: the path to et::SSLeay's documentation;
the list of constants given in the L<Net::SSLeay/Constants> section of this file
will be overwritten. Defaults to C<../lib/Net/SSLeay.pod>, relative to the path
to C<update-exported-constants>.

=item *

B<-t I<FILE>>, B<--test-file=I<FILE>>: the path at which to write the constant
autoloading test script. If a file exists at the given path, it will be
overwritten. Defaults to C<../t/local/21_constants.t>, relative to the path to
C<update-exported-constants>.

=back

The above defaults ensure that C<update-exported-constants> can be executed
from a directory containing the Net-SSLeay source code without needing to
specify any options.

=head1 CONFIGURATION

The configuration file is a plain text file containing libssl and libcrypto
constant names, one per line. Empty lines and lines beginning with C<#> are
ignored.

libssl and libcrypto constants are C preprocessor macro names.
C<update-exported-constants> checks that constant names given in the
configuration file appear to be valid macro names, and will output a
I<badly-formatted constant name; skipping> warning on stderr whenever it
encounters a line in the configuration file that does not appear to be a valid
macro name. Since the set of valid constant names differs between versions of
OpenSSL and LibreSSL, it is not possible to validate that constant names listed
in the configuration file are in fact valid constant names for a particular
libssl or libcrypto version.

=head1 OUTPUT

C<update-exported-constants> generates the following files (overwriting any file
that already exists at that path):

=over 4

=item *

A C source file defining a function with the prototype
C<static double constant(char*, size_t)>. For a given constant name and length,
this function returns the value of the constant with the given name if it is
recognised as exportable by Net::SSLeay and exists in libssl/libcrypto, returns
C<0> and sets L<errno> to C<ENOENT> if the constant is exportable but does not
exist in libssl/libcrypto, or returns C<0> and sets L<errno> to C<EINVAL> if the
constant is not recognised as exportable by Net::SSLeay. This file is expected
to be C<include>d by C<SSLeay.xs>.

=item *

A Net::SSLeay test script that ensures each constant is exportable if it is
defined, or raises a specific exception if it is not. This test script is
expected to run as part of the standard Net::SSLeay test suite.

=back

C<update-exported-constants> updates the following files (which therefore must
already exist and be writable):

=over 4

=item *

The source file for the Net::SSLeay module - the value of the C<@constants>
array defined in this file is overwritten with the new list of constants that
the module can export.

=item *

The Pod file documenting the Net::SSLeay module - the list of exportable
constants given in the L<Net::SSLeay/Constants> section of this file is
overwritten with the new list of constants that the module can export.

=back

=head1 DIAGNOSTICS

C<update-exported-constants> outputs a diagnostic message to stderr and
immediately exits with exit code 1 if an error occurs. Error messages listed
below indicate invalid input or a problem with the state of the system that can
usually be fixed. Error messages not listed below are internal and should never
be encountered under normal operation; please report any occurrences of such
errors as bugs (see L</BUGS>).

=over

=item B<Failed to parse command line options: configuration file I<PATH> does
not exist>

The configuration file listing the constants to export, as specified by the
B<-C> command line option (or C<constants.txt> in the same directory as
C<update-exported-constants> if a value for B<-C> was not specified), does not
exist. Ensure C<constants.txt> exists, or specify an alternative path with
B<-C I<PATH>>.

=item B<Failed to parse command line options: Net::SSLeay module file I<PATH>
does not exist>

C<update-exported-constants> updates and overwrites the Net::SSLeay module file
specified by the B<-m> command line option (or C<../lib/Net/SSLeay.pm> relative
to the path to C<update-exported-constants> if a value for B<-m> was not
specified), but a file could not be found at this path. Ensure
C<../lib/Net/SSLeay.pm> exists, or specify an alternative path with
B<-m I<PATH>>.

=item B<Failed to parse command line options: Pod file I<PATH> does not exist>

C<update-exported-constants> updates and overwrites the Pod file containing the
Net::SSLeay documentation at the path specified by the B<-p> command line option
(or C<../lib/Net/SSLeay.pod> relative to the path to
C<update-exported-constants> if a value for B<-p> was not specified), but a file
could not be found at this path. Ensure C<../lib/Net/SSLeay.pod> exists, or
specify an alternative path with B<-p I<PATH>>.

=item B<Failed to load configuration file: I<REASON>>

The configuration file could not be loaded because of I<REASON>, which is
probably an OS-level error. Ensure the path given by the B<-C> option, or the
default path if B<-C> was not specified, is readable.

=item B<Failed to generate constants file: I<REASON>>

The constants C source file could not be written because of I<REASON>, which is
probably an OS-level error. Ensure that the path given by the B<-c> option, or
the default path if B<-c> was not specified, is writable.

=item B<Failed to generate constants test script: I<REASON>>

The constants test script could not be written because of I<REASON>, which is
probably an OS-level error. Ensure that the path given by the B<-t> option, or
the default path if B<-t> was not specified, is writable.

=item B<Failed to update Net::SSLeay module file: could not find @constants
declaration>

The Net::SSLeay module file was read, but an updated constants list could not be
written to it because the definition of the C<@constants> array could not be
found. C<update-exported-constants> expects this array to be defined with the
following syntax:

    my @constants = qw(
        # <Constants list>
    );

Ensure the C<@constants> array is defined in this way in the Net::SSLeay module.

=item B<Failed to update Net::SSLeay module file: I<REASON>>

The Net::SSLeay module file could not be either read or written because of
I<REASON>, which is probably an OS-level error. Ensure that the path given by
the B<-m> option, or the default path if B<-m> was not specified, is both
readable and writable.

=item B<Failed to update Pod file: could not find constants block>

The Net::SSLeay documentation file was read, but an updated constants list could
not be written to it because the Pod code block listing the constants could not
be found. C<update-exported-constants> expects this block to be surrounded by
the following Pod commands:

    =for start_constants

        <Constants list>

    =for end_constants

Ensure the constants list is defined in this way in the documentation.

=item B<Failed to update Pod file: I<REASON>>

The Net::SSLeay documentation file could not be either read or written because
of I<REASON>, which is probably an OS-level error. Ensure that the path given by
the B<-p> option, or the default path if B<-p> was not specified, is both
readable and writable.

=back

=head1 LIMITATIONS

Net::SSLeay currently returns the values of libssl and libcrypto constants as
double-precision floating-point numbers, regardless of the data type of the
underlying constant as it is defined by OpenSSL and/or LibreSSL; the C source
file generated by C<update-exported-constants> therefore defines a function
C<constant> with the return type C<double>. While all constants currently
exported by Net::SSLeay can be stored in this way without loss of precision,
this may not necessarily be the case for all constants defined by libssl and
libcrypto, either now or in the future.

=head1 SEE ALSO

The man pages for OpenSSL and LibreSSL, which describe the constants they define
(and therefore the constants that may be exported by Net::SSLeay).

=head1 BUGS

If you encounter a problem with this program that you believe is a bug, please
L<create a new issue|https://github.com/radiator-software/p5-net-ssleay/issues/new>
in the Net-SSLeay GitHub repository. Please make sure your bug report includes
the following information:

=over

=item *

the list of command line options passed to C<update-exported-constants>;

=item *

the full configuration file given by the B<-C> command line option (or the
default configuration file if B<-C> was not specified);

=item *

the full output of C<update-exported-constants>;

=item *

your operating system name and version;

=item *

the output of C<perl -V>;

=item *

the version of Net-SSLeay you are using.

=back

=head1 AUTHORS

Originally written by Chris Novakovic.

Maintained by Chris Novakovic, Tuure Vartiainen and Heikki Vatiainen.

=head1 COPYRIGHT AND LICENSE

Copyright 2021- Chris Novakovic <chris@chrisn.me.uk>.

Copyright 2021- Tuure Vartiainen <vartiait@radiatorsoftware.com>.

Copyright 2021- Heikki Vatiainen <hvn@radiatorsoftware.com>.

This module is released under the terms of the Artistic License 2.0. For
details, see the C<LICENSE> file distributed with Net-SSLeay's source code.

=cut

__DATA__
[section:constants_c_header]
/*
 * This file is automatically generated - do not manually modify it.
 *
 * To add or remove a constant, edit helper_script/constants.txt, then run
 * helper_script/update-exported-constants.
 */

[section:assignment_clause_for_type]

#ifdef {{ value }}
        return {{ value }};
#else
        goto not_there;
#endif
[section:return_statement_for_notfound]

  errno = EINVAL;
  return 0;

not_there:
  errno = ENOENT;
  return 0;
[section:constants_test]
# This file is automatically generated - do not manually modify it.
#
# To add or remove a constant, edit helper_script/constants.txt, then run
# helper_script/update-exported-constants.

use lib 'inc';

use Net::SSLeay;
use Test::Net::SSLeay qw(dies_like);

# We rely on symbolic references in the dies_like() tests:
no strict 'refs';

plan tests => {{ tests }};

my @constants = qw(
{{ constants }}
);

my %exported = map { $_ => 1 } @Net::SSLeay::EXPORT_OK;
my @missing;

for my $c (@constants) {
    dies_like(
        sub { "Net::SSLeay::$c"->(); die "ok\n"; },
        qr/^(?:ok\n$|Your vendor has not defined SSLeay macro )/,
        "constant is exported or not defined: $c"
    );
    push @missing, $c if !exists $exported{$c};
}

is(
    join( q{,}, sort @missing ),
    '',
    'no constants missing from @EXPORT_OK (total missing: ' . scalar(@missing) . ')'
);

dies_like(
    sub { Net::SSLeay::_NET_SSLEAY_TEST_UNDEFINED_CONSTANT() },
    qr/^Your vendor has not defined SSLeay macro _NET_SSLEAY_TEST_UNDEFINED_CONSTANT/,
    'referencing an undefined constant raises an exception'
);