#! /usr/bin/env perl
# Copyright 2018-2021 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (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::Util;

use strict;
use warnings;
use Carp;

use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.1";
@ISA = qw(Exporter);
@EXPORT = qw(cmp_versions quotify1 quotify_l dump_data);
@EXPORT_OK = qw();

=head1 NAME

OpenSSL::Util - small OpenSSL utilities

=head1 SYNOPSIS

  use OpenSSL::Util;

  $versiondiff = cmp_versions('1.0.2k', '3.0.1');
  # $versiondiff should be -1

  $versiondiff = cmp_versions('1.1.0', '1.0.2a');
  # $versiondiff should be 1

  $versiondiff = cmp_versions('1.1.1', '1.1.1');
  # $versiondiff should be 0

=head1 DESCRIPTION

=over

=item B<cmp_versions "VERSION1", "VERSION2">

Compares VERSION1 with VERSION2, paying attention to OpenSSL versioning.

Returns 1 if VERSION1 is greater than VERSION2, 0 if they are equal, and
-1 if VERSION1 is less than VERSION2.

=back

=cut

# Until we're rid of everything with the old version scheme,
# we need to be able to handle older style x.y.zl versions.
# In terms of comparison, the x.y.zl and the x.y.z schemes
# are compatible...  mostly because the latter starts at a
# new major release with a new major number.
sub _ossl_versionsplit {
    my $textversion = shift;
    return $textversion if $textversion eq '*';
    my ($major,$minor,$edit,$letter) =
        $textversion =~ /^(\d+)\.(\d+)\.(\d+)([a-z]{0,2})$/;

    return ($major,$minor,$edit,$letter);
}

sub cmp_versions {
    my @a_split = _ossl_versionsplit(shift);
    my @b_split = _ossl_versionsplit(shift);
    my $verdict = 0;

    while (@a_split) {
        # The last part is a letter sequence (or a '*')
        if (scalar @a_split == 1) {
            $verdict = $a_split[0] cmp $b_split[0];
        } else {
            $verdict = $a_split[0] <=> $b_split[0];
        }
        shift @a_split;
        shift @b_split;
        last unless $verdict == 0;
    }

    return $verdict;
}

# It might be practical to quotify some strings and have them protected
# from possible harm.  These functions primarily quote things that might
# be interpreted wrongly by a perl eval.

=over 4

=item quotify1 STRING

This adds quotes (") around the given string, and escapes any $, @, \,
" and ' by prepending a \ to them.

=back

=cut

sub quotify1 {
    my $s = shift @_;
    $s =~ s/([\$\@\\"'])/\\$1/g;
    '"'.$s.'"';
}

=over 4

=item quotify_l LIST

For each defined element in LIST (i.e. elements that aren't undef), have
it quotified with 'quotify1'.
Undefined elements are ignored.

=cut

sub quotify_l {
    map {
        if (!defined($_)) {
            ();
        } else {
            quotify1($_);
        }
    } @_;
}

=item dump_data REF, OPTS

Dump the data from REF into a string that can be evaluated into the same
data by Perl.

OPTS is the rest of the arguments, expected to be pairs formed with C<< => >>.
The following OPTS keywords are understood:

=over 4

=item B<delimiters =E<gt> 0 | 1>

Include the outer delimiter of the REF type in the resulting string if C<1>,
otherwise not.

=item B<indent =E<gt> num>

The indentation of the caller, i.e. an initial value.  If not given, there
will be no indentation at all, and the string will only be one line.

=back

=cut

sub dump_data {
    my $ref = shift;
    # Available options:
    # indent           => callers indentation ( undef for no indentation,
    #                     an integer otherwise )
    # delimiters       => 1 if outer delimiters should be added
    my %opts = @_;

    my $indent = $opts{indent} // 1;
    # Indentation of the whole structure, where applicable
    my $nlindent1 = defined $opts{indent} ? "\n" . ' ' x $indent : ' ';
    # Indentation of individual items, where applicable
    my $nlindent2 = defined $opts{indent} ? "\n" . ' ' x ($indent + 4) : ' ';
    my %subopts = ();

    $subopts{delimiters} = 1;
    $subopts{indent} = $opts{indent} + 4 if defined $opts{indent};

    my $product;      # Finished product, or reference to a function that
                      # produces a string, given $_
    # The following are only used when $product is a function reference
    my $delim_l;      # Left delimiter of structure
    my $delim_r;      # Right delimiter of structure
    my $separator;    # Item separator
    my @items;        # Items to iterate over

     if (ref($ref) eq "ARRAY") {
         if (scalar @$ref == 0) {
             $product = $opts{delimiters} ? '[]' : '';
         } else {
             $product = sub {
                 dump_data(\$_, %subopts)
             };
             $delim_l = ($opts{delimiters} ? '[' : '').$nlindent2;
             $delim_r = $nlindent1.($opts{delimiters} ? ']' : '');
             $separator = ",$nlindent2";
             @items = @$ref;
         }
     } elsif (ref($ref) eq "HASH") {
         if (scalar keys %$ref == 0) {
             $product = $opts{delimiters} ? '{}' : '';
         } else {
             $product = sub {
                 quotify1($_) . " => " . dump_data($ref->{$_}, %subopts);
             };
             $delim_l = ($opts{delimiters} ? '{' : '').$nlindent2;
             $delim_r = $nlindent1.($opts{delimiters} ? '}' : '');
             $separator = ",$nlindent2";
             @items = sort keys %$ref;
         }
     } elsif (ref($ref) eq "SCALAR") {
         $product = defined $$ref ? quotify1 $$ref : "undef";
     } else {
         $product = defined $ref ? quotify1 $ref : "undef";
     }

     if (ref($product) eq "CODE") {
         $delim_l . join($separator, map { &$product } @items) . $delim_r;
     } else {
         $product;
     }
}

=back

=cut

1;