1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
#! /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;
|
