Latest update
This commit is contained in:
@@ -12,6 +12,7 @@ use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Scalar::Util qw(blessed);
|
||||
use OpenSSL::Util;
|
||||
|
||||
use constant {
|
||||
# "magic" filters, see the filters at the end of the file
|
||||
@@ -90,11 +91,11 @@ sub new {
|
||||
name2num => {}, # Name to number dictionary
|
||||
aliases => {}, # Aliases cache.
|
||||
stats => {}, # Statistics, see 'sub validate'
|
||||
currversion => $opts{version} // '*', # '*' is for "we don't care"
|
||||
debug => $opts{debug},
|
||||
};
|
||||
bless $instance, $class;
|
||||
|
||||
$instance->set_version($opts{version});
|
||||
$instance->load($opts{from}) if defined($opts{from});
|
||||
|
||||
return $instance;
|
||||
@@ -368,6 +369,18 @@ sub _parse_features {
|
||||
return %features;
|
||||
}
|
||||
|
||||
sub _adjust_version {
|
||||
my $self = shift;
|
||||
my $version = shift;
|
||||
my $baseversion = $self->{baseversion};
|
||||
|
||||
$version = $baseversion
|
||||
if ($baseversion ne '*' && $version ne '*'
|
||||
&& cmp_versions($baseversion, $version) > 0);
|
||||
|
||||
return $version;
|
||||
}
|
||||
|
||||
=item B<$ordinals-E<gt>add NAME, TYPE, LIST>
|
||||
|
||||
Adds a new item named NAME with the type TYPE, and a set of C macros in
|
||||
@@ -410,7 +423,8 @@ sub add {
|
||||
OpenSSL::Ordinals::Item->new( name => $name,
|
||||
type => $type,
|
||||
number => $number,
|
||||
version => $version,
|
||||
version =>
|
||||
$self->_adjust_version($version),
|
||||
exists => 1,
|
||||
platforms => { %platforms },
|
||||
features => [
|
||||
@@ -497,7 +511,7 @@ sub add_alias {
|
||||
name => $alias,
|
||||
type => $items[0]->type(),
|
||||
number => $items[0]->number(),
|
||||
version => $items[0]->version(),
|
||||
version => $self->_adjust_version($items[0]->version()),
|
||||
exists => $items[0]->exists(),
|
||||
platforms => { %platforms },
|
||||
features => [ $items[0]->features() ]
|
||||
@@ -518,18 +532,61 @@ sub add_alias {
|
||||
|
||||
=item B<$ordinals-E<gt>set_version VERSION>
|
||||
|
||||
=item B<$ordinals-E<gt>set_version VERSION BASEVERSION>
|
||||
|
||||
Sets the default version for new symbol to VERSION.
|
||||
|
||||
If given, BASEVERSION sets the base version, i.e. the minimum version
|
||||
for all symbols. If not given, it will be calculated as follows:
|
||||
|
||||
=over 4
|
||||
|
||||
If the given version is '*', then the base version will also be '*'.
|
||||
|
||||
If the given version starts with '0.', the base version will be '0.0.0'.
|
||||
|
||||
If the given version starts with '1.0.', the base version will be '1.0.0'.
|
||||
|
||||
If the given version starts with '1.1.', the base version will be '1.1.0'.
|
||||
|
||||
If the given version has a first number C<N> that's greater than 1, the
|
||||
base version will be formed from C<N>: 'N.0.0'.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub set_version {
|
||||
my $self = shift;
|
||||
my $version = shift;
|
||||
# '*' is for "we don't care"
|
||||
my $version = shift // '*';
|
||||
my $baseversion = shift // '*';
|
||||
|
||||
$version //= '*';
|
||||
$version =~ s|-.*||g;
|
||||
$version =~ s|\.|_|g;
|
||||
|
||||
if ($baseversion eq '*') {
|
||||
$baseversion = $version;
|
||||
if ($baseversion ne '*') {
|
||||
if ($baseversion =~ m|^(\d+)\.|, $1 > 1) {
|
||||
$baseversion = "$1.0.0";
|
||||
} else {
|
||||
$baseversion =~ s|^0\..*$|0.0.0|;
|
||||
$baseversion =~ s|^1\.0\..*$|1.0.0|;
|
||||
$baseversion =~ s|^1\.1\..*$|1.1.0|;
|
||||
|
||||
die 'Invalid version'
|
||||
if ($baseversion ne '0.0.0'
|
||||
&& $baseversion !~ m|^1\.[01]\.0$|);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
die 'Invalid base version'
|
||||
if ($baseversion ne '*' && $version ne '*'
|
||||
&& cmp_versions($baseversion, $version) > 0);
|
||||
|
||||
$self->{currversion} = $version;
|
||||
$self->{baseversion} = $baseversion;
|
||||
foreach ($self->items(filter => sub { $_[0] eq '*' })) {
|
||||
$_->{version} = $self->{currversion};
|
||||
}
|
||||
@@ -701,10 +758,13 @@ sub new {
|
||||
if ($opts{name} && $opts{version} && defined $opts{exists} && $opts{type}
|
||||
&& ref($opts{platforms} // {}) eq 'HASH'
|
||||
&& ref($opts{features} // []) eq 'ARRAY') {
|
||||
my $version = $opts{version};
|
||||
$version =~ s|_|.|g;
|
||||
|
||||
$instance = { name => $opts{name},
|
||||
type => $opts{type},
|
||||
number => $opts{number},
|
||||
version => $opts{version},
|
||||
version => $version,
|
||||
exists => !!$opts{exists},
|
||||
platforms => { %{$opts{platforms} // {}} },
|
||||
features => [ sort @{$opts{features} // []} ] };
|
||||
@@ -784,10 +844,12 @@ sub to_string {
|
||||
croak "Too many arguments" if @_;
|
||||
my %platforms = $self->platforms();
|
||||
my @features = $self->features();
|
||||
my $version = $self->version();
|
||||
$version =~ s|\.|_|g;
|
||||
return sprintf "%-39s %d\t%s\t%s:%s:%s:%s",
|
||||
$self->name(),
|
||||
$self->number(),
|
||||
$self->version(),
|
||||
$version,
|
||||
$self->exists() ? 'EXIST' : 'NOEXIST',
|
||||
join(',', (map { ($platforms{$_} ? '' : '!') . $_ }
|
||||
sort keys %platforms)),
|
||||
@@ -841,33 +903,10 @@ OpenSSL::Ordinals::Item objects.
|
||||
=cut
|
||||
|
||||
sub by_version {
|
||||
# Until we're rid of everything with the old version scheme,
|
||||
# we need to be able to handle older style x.y.zl versions.
|
||||
sub _ossl_versionsplit {
|
||||
my $textversion = shift;
|
||||
return $textversion if $textversion eq '*';
|
||||
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]->version());
|
||||
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;
|
||||
}
|
||||
$verdict;
|
||||
};
|
||||
# cmp_versions comes from OpenSSL::Util
|
||||
return cmp_versions($_[0]->version(), $_[1]->version());
|
||||
}
|
||||
}
|
||||
|
||||
=back
|
||||
@@ -891,9 +930,8 @@ matching B<VERSION>.
|
||||
sub f_version {
|
||||
my $version = shift;
|
||||
|
||||
$version =~ s|\.|_|g if $version;
|
||||
croak "No version specified"
|
||||
unless $version && $version =~ /^\d+_\d+_\d+[a-z]{0,2}$/;
|
||||
unless $version && $version =~ /^\d+\.\d+\.\d+[a-z]{0,2}$/;
|
||||
|
||||
return sub { $_[0]->version() eq $version };
|
||||
}
|
||||
|
||||
@@ -0,0 +1,88 @@
|
||||
#! /usr/bin/env perl
|
||||
# Copyright 2018 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::Ordinals;
|
||||
|
||||
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);
|
||||
@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;
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user