| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package X500::DN::Marpa; |
|
2
|
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
15998
|
use strict; |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
60
|
|
|
4
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
|
2
|
|
|
|
|
7
|
|
|
|
2
|
|
|
|
|
82
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
2
|
|
|
|
|
15
|
use Const::Exporter constants => |
|
7
|
|
|
|
|
|
|
[ |
|
8
|
|
|
|
|
|
|
nothing_is_fatal => 0, # The default. |
|
9
|
|
|
|
|
|
|
print_errors => 1, |
|
10
|
|
|
|
|
|
|
print_warnings => 2, |
|
11
|
|
|
|
|
|
|
print_debugs => 4, |
|
12
|
|
|
|
|
|
|
ambiguity_is_fatal => 8, |
|
13
|
|
|
|
|
|
|
exhaustion_is_fatal => 16, |
|
14
|
|
|
|
|
|
|
long_descriptors => 32, |
|
15
|
|
|
|
|
|
|
return_hex_as_chars => 64, |
|
16
|
2
|
|
|
2
|
|
2717
|
]; |
|
|
2
|
|
|
|
|
26715
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
2
|
|
|
2
|
|
2799
|
use Marpa::R2; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use Moo; |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use Set::Array; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Types::Standard qw/Any Int Str/; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use Try::Tiny; |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use X500::DN::Marpa::Actions; |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has bnf => |
|
31
|
|
|
|
|
|
|
( |
|
32
|
|
|
|
|
|
|
default => sub{return ''}, |
|
33
|
|
|
|
|
|
|
is => 'rw', |
|
34
|
|
|
|
|
|
|
isa => Any, |
|
35
|
|
|
|
|
|
|
required => 0, |
|
36
|
|
|
|
|
|
|
); |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
has error_message => |
|
39
|
|
|
|
|
|
|
( |
|
40
|
|
|
|
|
|
|
default => sub{return ''}, |
|
41
|
|
|
|
|
|
|
is => 'rw', |
|
42
|
|
|
|
|
|
|
isa => Str, |
|
43
|
|
|
|
|
|
|
required => 0, |
|
44
|
|
|
|
|
|
|
); |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
has error_number => |
|
47
|
|
|
|
|
|
|
( |
|
48
|
|
|
|
|
|
|
default => sub{return 0}, |
|
49
|
|
|
|
|
|
|
is => 'rw', |
|
50
|
|
|
|
|
|
|
isa => Int, |
|
51
|
|
|
|
|
|
|
required => 0, |
|
52
|
|
|
|
|
|
|
); |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has grammar => |
|
55
|
|
|
|
|
|
|
( |
|
56
|
|
|
|
|
|
|
default => sub {return ''}, |
|
57
|
|
|
|
|
|
|
is => 'rw', |
|
58
|
|
|
|
|
|
|
isa => Any, |
|
59
|
|
|
|
|
|
|
required => 0, |
|
60
|
|
|
|
|
|
|
); |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has options => |
|
63
|
|
|
|
|
|
|
( |
|
64
|
|
|
|
|
|
|
default => sub{return 0}, |
|
65
|
|
|
|
|
|
|
is => 'rw', |
|
66
|
|
|
|
|
|
|
isa => Int, |
|
67
|
|
|
|
|
|
|
required => 0, |
|
68
|
|
|
|
|
|
|
); |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
has recce => |
|
71
|
|
|
|
|
|
|
( |
|
72
|
|
|
|
|
|
|
default => sub{return ''}, |
|
73
|
|
|
|
|
|
|
is => 'rw', |
|
74
|
|
|
|
|
|
|
isa => Any, |
|
75
|
|
|
|
|
|
|
required => 0, |
|
76
|
|
|
|
|
|
|
); |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# The default value of $self -> stack is set to Set::Array -> new, so that if anyone |
|
79
|
|
|
|
|
|
|
# accesses $self -> stack before calling $self -> parse, gets a meaningful result. |
|
80
|
|
|
|
|
|
|
# This is despite the fact the parser() resets the stack at the start of each call. |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
has stack => |
|
83
|
|
|
|
|
|
|
( |
|
84
|
|
|
|
|
|
|
default => sub{return Set::Array -> new}, |
|
85
|
|
|
|
|
|
|
is => 'rw', |
|
86
|
|
|
|
|
|
|
isa => Any, |
|
87
|
|
|
|
|
|
|
required => 0, |
|
88
|
|
|
|
|
|
|
); |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has text => |
|
91
|
|
|
|
|
|
|
( |
|
92
|
|
|
|
|
|
|
default => sub{return ''}, |
|
93
|
|
|
|
|
|
|
is => 'rw', |
|
94
|
|
|
|
|
|
|
isa => Str, |
|
95
|
|
|
|
|
|
|
required => 0, |
|
96
|
|
|
|
|
|
|
); |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
my(%descriptors) = |
|
99
|
|
|
|
|
|
|
( |
|
100
|
|
|
|
|
|
|
cn => 'commonName', |
|
101
|
|
|
|
|
|
|
c => 'countryName', |
|
102
|
|
|
|
|
|
|
dc => 'domainComponent', |
|
103
|
|
|
|
|
|
|
l => 'localityName', |
|
104
|
|
|
|
|
|
|
ou => 'organizationalUnitName', |
|
105
|
|
|
|
|
|
|
o => 'organizationName', |
|
106
|
|
|
|
|
|
|
st => 'stateOrProvinceName', |
|
107
|
|
|
|
|
|
|
street => 'streetAddress', |
|
108
|
|
|
|
|
|
|
uid => 'userId', |
|
109
|
|
|
|
|
|
|
); |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
our $VERSION = '0.80'; |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub BUILD |
|
116
|
|
|
|
|
|
|
{ |
|
117
|
|
|
|
|
|
|
my($self) = @_; |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Policy: Event names are always the same as the name of the corresponding lexeme. |
|
120
|
|
|
|
|
|
|
# |
|
121
|
|
|
|
|
|
|
# References: |
|
122
|
|
|
|
|
|
|
# o https://www.ietf.org/rfc/rfc4512.txt (secondary) |
|
123
|
|
|
|
|
|
|
# - Lightweight Directory Access Protocol (LDAP): Directory Information Models |
|
124
|
|
|
|
|
|
|
# o https://www.ietf.org/rfc/rfc4514.txt (primary) |
|
125
|
|
|
|
|
|
|
# - Lightweight Directory Access Protocol (LDAP): String Representation of Distinguished Names |
|
126
|
|
|
|
|
|
|
# o https://www.ietf.org/rfc/rfc4517.txt |
|
127
|
|
|
|
|
|
|
# - Lightweight Directory Access Protocol (LDAP): Syntaxes and Matching Rules |
|
128
|
|
|
|
|
|
|
# o https://www.ietf.org/rfc/rfc4234.txt |
|
129
|
|
|
|
|
|
|
# - Augmented BNF for Syntax Specifications: ABNF |
|
130
|
|
|
|
|
|
|
# o https://www.ietf.org/rfc/rfc3629.txt |
|
131
|
|
|
|
|
|
|
# - UTF-8, a transformation format of ISO 10646 |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
my($bnf) = <<'END_OF_GRAMMAR'; |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
:default ::= action => [values] |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
lexeme default = latm => 1 |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
:start ::= dn |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# dn. |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
dn ::= |
|
144
|
|
|
|
|
|
|
dn ::= rdn |
|
145
|
|
|
|
|
|
|
| rdn separators dn |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
separators ::= separator+ |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
separator ::= comma |
|
150
|
|
|
|
|
|
|
| space |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
rdn ::= attribute_pair rank => 1 |
|
153
|
|
|
|
|
|
|
| attribute_pair spacer plus spacer rdn rank => 2 |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
attribute_pair ::= attribute_type spacer equals spacer attribute_value |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
spacer ::= space* |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# attribute_type. |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
attribute_type ::= description action => attribute_type |
|
162
|
|
|
|
|
|
|
| numeric_oid action => attribute_type |
|
163
|
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
description ::= description_prefix description_suffix |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
description_prefix ::= alpha |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
description_suffix ::= description_tail* |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
description_tail ::= alpha |
|
171
|
|
|
|
|
|
|
| digit |
|
172
|
|
|
|
|
|
|
| hyphen |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
numeric_oid ::= number oid_suffix |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
number ::= digit |
|
177
|
|
|
|
|
|
|
| digit_sequence |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
digit_sequence ::= non_zero_digit digit_suffix |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
digit_suffix ::= digit+ |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
oid_suffix ::= oid_sequence+ |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
oid_sequence ::= dot number |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# attribute_value. |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
attribute_value ::= string action => attribute_value |
|
190
|
|
|
|
|
|
|
| hex_string action => attribute_value |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
string ::= |
|
193
|
|
|
|
|
|
|
string ::= string_prefix string_suffix |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
string_prefix ::= lutf1 |
|
196
|
|
|
|
|
|
|
| utfmb |
|
197
|
|
|
|
|
|
|
| pair |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
utfmb ::= utf2 |
|
200
|
|
|
|
|
|
|
| utf3 |
|
201
|
|
|
|
|
|
|
| utf4 |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
utf2 ::= utf2_prefix utf2_suffix |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
utf3 ::= utf3_prefix_1 utf3_suffix_1 |
|
206
|
|
|
|
|
|
|
| utf3_prefix_2 utf3_suffix_2 |
|
207
|
|
|
|
|
|
|
| utf3_prefix_3 utf3_suffix_3 |
|
208
|
|
|
|
|
|
|
| utf3_prefix_4 utf3_suffix_4 |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
utf4 ::= utf4_prefix_1 utf4_suffix_1 |
|
211
|
|
|
|
|
|
|
| utf4_prefix_2 utf4_suffix_2 |
|
212
|
|
|
|
|
|
|
| utf4_prefix_3 utf4_suffix_3 |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
pair ::= escape_char escaped_char |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
escaped_char ::= escape_char |
|
217
|
|
|
|
|
|
|
| special_char |
|
218
|
|
|
|
|
|
|
| hex_pair |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
string_suffix ::= |
|
221
|
|
|
|
|
|
|
string_suffix ::= string_suffix_1 string_suffix_2 |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
string_suffix_1 ::= string_suffix_1_1* |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
string_suffix_1_1 ::= sutf1 |
|
226
|
|
|
|
|
|
|
| utfmb |
|
227
|
|
|
|
|
|
|
| pair |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
string_suffix_2 ::= tutf1 |
|
230
|
|
|
|
|
|
|
| utfmb |
|
231
|
|
|
|
|
|
|
| pair |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
hex_string ::= sharp hex_suffix |
|
234
|
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
hex_suffix ::= hex_pair+ |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
hex_pair ::= hex_digit hex_digit |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Lexemes in alphabetical order. |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
alpha ~ [A-Za-z] # [\x41-\x5a\x61-\x7a]. |
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
comma ~ ',' # [\x2c]. |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
digit ~ [0-9] # [\x30-\x39]. |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
dot ~ '.' # [\x2e]. |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
equals ~ '=' # [\x3d]. |
|
250
|
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
escape_char ~ '\' # [\x5c]. Use ' in comment for UltraEdit syntax hiliter. |
|
252
|
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
hex_digit ~ [0-9A-Fa-f] # [\x30-\x39\x41-\x46\x61-\x66]. |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
hyphen ~ '-' |
|
256
|
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# \x01-\x1f: All control chars except the first (^@). Skip [ ] = [\x20]. |
|
258
|
|
|
|
|
|
|
# \x21: !. Skip ["#] = [\x22\x23]. |
|
259
|
|
|
|
|
|
|
# \x24-\x2a: $%&'()*. Skip: [+,] = [\x2b\x2c]. |
|
260
|
|
|
|
|
|
|
# \x2d-\x3a: -./0123456789:. Skip [;<] = [\x3b\x3c]. |
|
261
|
|
|
|
|
|
|
# \x3d: =. |
|
262
|
|
|
|
|
|
|
# \x3f-\x5b: ?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[. |
|
263
|
|
|
|
|
|
|
# \x5d-\x7f: ]^_`abcdefghijklmnopqrstuvwxyz{|}~ and DEL. |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
lutf1 ~ [\x01-\x1f\x21\x24-\x2a\x2d-\x3a\x3d\x3f-\x5b\x5d-\x7f] |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
non_zero_digit ~ [1-9] # [\x31-\x39]. |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
plus ~ '+' # [\x2b]. |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sharp ~ '#' # [\x23]. |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
space ~ ' ' # [\x20]. |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
special_char ~ ["+,;<> #=] # Use " in comment for UltraEdit syntax hiliter. |
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sutf1 ~ [\x01-\x21\x23-\x2a\x2d-\x3a\x3d\x3f-\x5b\x5d-\x7f] |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
tutf1 ~ [\x01-\x1f\x21\x23-\x2a\x2d-\x3a\x3d\x3f-\x5b\x5d-\x7f] |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
utf0 ~ [\x80-\xbf] |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
utf2_prefix ~ [\xc2-\xdf] |
|
284
|
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
utf2_suffix ~ utf0 |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
utf3_prefix_1 ~ [\xe0\xa0-\xbf] |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
utf3_suffix_1 ~ utf0 |
|
290
|
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
utf3_prefix_2 ~ [\xe1-\xec] |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
utf3_suffix_2 ~ utf0 utf0 |
|
294
|
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
utf3_prefix_3 ~ [\xed\x80-\x9f] |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
utf3_suffix_3 ~ utf0 |
|
298
|
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
utf3_prefix_4 ~ [\xee-\xef] |
|
300
|
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
utf3_suffix_4 ~ utf0 utf0 |
|
302
|
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
utf4_prefix_1 ~ [\xf0\x90-\xbf] |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
utf4_suffix_1 ~ utf0 utf0 |
|
306
|
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
utf4_prefix_2 ~ [\xf1-\xf3] |
|
308
|
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
utf4_suffix_2 ~ utf0 utf0 utf0 |
|
310
|
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
utf4_prefix_3 ~ [\xf4\x80-\x8f] |
|
312
|
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
utf4_suffix_3 ~ utf0 utf0 |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
END_OF_GRAMMAR |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
$self -> bnf($bnf); |
|
318
|
|
|
|
|
|
|
$self -> grammar |
|
319
|
|
|
|
|
|
|
( |
|
320
|
|
|
|
|
|
|
Marpa::R2::Scanless::G -> new |
|
321
|
|
|
|
|
|
|
({ |
|
322
|
|
|
|
|
|
|
source => \$self -> bnf |
|
323
|
|
|
|
|
|
|
}) |
|
324
|
|
|
|
|
|
|
); |
|
325
|
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
} # End of BUILD. |
|
327
|
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub decode_result |
|
331
|
|
|
|
|
|
|
{ |
|
332
|
|
|
|
|
|
|
my($self, $result) = @_; |
|
333
|
|
|
|
|
|
|
my(@worklist) = $result; |
|
334
|
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
my($obj); |
|
336
|
|
|
|
|
|
|
my($ref_type); |
|
337
|
|
|
|
|
|
|
my(@stack); |
|
338
|
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
do |
|
340
|
|
|
|
|
|
|
{ |
|
341
|
|
|
|
|
|
|
$obj = shift @worklist; |
|
342
|
|
|
|
|
|
|
$ref_type = ref $obj; |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
if ($ref_type eq 'ARRAY') |
|
345
|
|
|
|
|
|
|
{ |
|
346
|
|
|
|
|
|
|
unshift @worklist, @$obj; |
|
347
|
|
|
|
|
|
|
} |
|
348
|
|
|
|
|
|
|
elsif ($ref_type eq 'HASH') |
|
349
|
|
|
|
|
|
|
{ |
|
350
|
|
|
|
|
|
|
push @stack, {%$obj}; |
|
351
|
|
|
|
|
|
|
} |
|
352
|
|
|
|
|
|
|
elsif ($ref_type) |
|
353
|
|
|
|
|
|
|
{ |
|
354
|
|
|
|
|
|
|
die "Unsupported object type $ref_type\n"; |
|
355
|
|
|
|
|
|
|
} |
|
356
|
|
|
|
|
|
|
else |
|
357
|
|
|
|
|
|
|
{ |
|
358
|
|
|
|
|
|
|
push @stack, $obj; |
|
359
|
|
|
|
|
|
|
} |
|
360
|
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
} while (@worklist); |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
return [@stack]; |
|
364
|
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
} # End of decode_result. |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
368
|
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub _combine |
|
370
|
|
|
|
|
|
|
{ |
|
371
|
|
|
|
|
|
|
my($self) = @_; |
|
372
|
|
|
|
|
|
|
my(@temp) = $self -> stack -> print; |
|
373
|
|
|
|
|
|
|
my($multivalued) = 0; |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
my(@dn); |
|
376
|
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
for (my $i = 0; $i <= $#temp; $i++) |
|
378
|
|
|
|
|
|
|
{ |
|
379
|
|
|
|
|
|
|
# The 'multivalued' key is use for temporary storage. See parse(). |
|
380
|
|
|
|
|
|
|
# 'count' holds the count of RDNs within this stack element. |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
if ($temp[$i]{multivalued}) |
|
383
|
|
|
|
|
|
|
{ |
|
384
|
|
|
|
|
|
|
$multivalued = 1; |
|
385
|
|
|
|
|
|
|
} |
|
386
|
|
|
|
|
|
|
elsif ($multivalued) |
|
387
|
|
|
|
|
|
|
{ |
|
388
|
|
|
|
|
|
|
$multivalued = 0; |
|
389
|
|
|
|
|
|
|
$dn[$#dn]{count} += 1; |
|
390
|
|
|
|
|
|
|
$dn[$#dn]{value} .= "+$temp[$i]{type}=$temp[$i]{value}"; |
|
391
|
|
|
|
|
|
|
} |
|
392
|
|
|
|
|
|
|
else |
|
393
|
|
|
|
|
|
|
{ |
|
394
|
|
|
|
|
|
|
# Zap 'multivalued' so it does not end up in the stack. |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
undef $temp[$i]{multivalued}; |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
push @dn, $temp[$i]; |
|
399
|
|
|
|
|
|
|
} |
|
400
|
|
|
|
|
|
|
} |
|
401
|
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
$self -> stack(Set::Array -> new(@dn) ); |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
} # End of _combine. |
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
407
|
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub dn |
|
409
|
|
|
|
|
|
|
{ |
|
410
|
|
|
|
|
|
|
my($self) = @_; |
|
411
|
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
return join(',', map{"$$_{type}=$$_{value}"} reverse @{$self -> stack}); |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
} # End of dn. |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub openssl_dn |
|
419
|
|
|
|
|
|
|
{ |
|
420
|
|
|
|
|
|
|
my($self) = @_; |
|
421
|
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
return join('+', map{"$$_{type}=$$_{value}"} @{$self -> stack}); |
|
423
|
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
} # End of openssl_dn. |
|
425
|
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub parse |
|
429
|
|
|
|
|
|
|
{ |
|
430
|
|
|
|
|
|
|
my($self, $string) = @_; |
|
431
|
|
|
|
|
|
|
$self -> text($string) if (defined $string); |
|
432
|
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
$self -> recce |
|
434
|
|
|
|
|
|
|
( |
|
435
|
|
|
|
|
|
|
Marpa::R2::Scanless::R -> new |
|
436
|
|
|
|
|
|
|
({ |
|
437
|
|
|
|
|
|
|
exhaustion => 'event', |
|
438
|
|
|
|
|
|
|
grammar => $self -> grammar, |
|
439
|
|
|
|
|
|
|
ranking_method => 'high_rule_only', |
|
440
|
|
|
|
|
|
|
semantics_package => 'X500::DN::Marpa::Actions', |
|
441
|
|
|
|
|
|
|
}) |
|
442
|
|
|
|
|
|
|
); |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# Return 0 for success and 1 for failure. |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
my($result) = 0; |
|
447
|
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
my($message); |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
try |
|
451
|
|
|
|
|
|
|
{ |
|
452
|
|
|
|
|
|
|
my($text) = $self -> text; |
|
453
|
|
|
|
|
|
|
my($text_length) = length($text); |
|
454
|
|
|
|
|
|
|
my($read_length) = $self -> recce -> read(\$text); |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
if ($text_length != $read_length) |
|
457
|
|
|
|
|
|
|
{ |
|
458
|
|
|
|
|
|
|
die "Text is $text_length characters, but read() only read $read_length characters. \n"; |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
if ($self -> recce -> exhausted) |
|
462
|
|
|
|
|
|
|
{ |
|
463
|
|
|
|
|
|
|
$message = 'Parse exhausted'; |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
$self -> error_message($message); |
|
466
|
|
|
|
|
|
|
$self -> error_number(1); |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
if ($self -> options & exhaustion_is_fatal) |
|
469
|
|
|
|
|
|
|
{ |
|
470
|
|
|
|
|
|
|
# This 'die' is inside try{}catch{}, which adds the prefix 'Error: '. |
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
die "$message\n"; |
|
473
|
|
|
|
|
|
|
} |
|
474
|
|
|
|
|
|
|
else |
|
475
|
|
|
|
|
|
|
{ |
|
476
|
|
|
|
|
|
|
$self -> error_number(-1); |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
print "Warning: $message\n" if ($self -> options & print_warnings); |
|
479
|
|
|
|
|
|
|
} |
|
480
|
|
|
|
|
|
|
} |
|
481
|
|
|
|
|
|
|
elsif (my $status = $self -> recce -> ambiguous) |
|
482
|
|
|
|
|
|
|
{ |
|
483
|
|
|
|
|
|
|
my($terminals) = $self -> recce -> terminals_expected; |
|
484
|
|
|
|
|
|
|
$terminals = ['(None)'] if ($#$terminals < 0); |
|
485
|
|
|
|
|
|
|
$message = "Ambiguous parse. Status: $status. Terminals expected: " . join(', ', @$terminals); |
|
486
|
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
$self -> error_message($message); |
|
488
|
|
|
|
|
|
|
$self -> error_number(2); |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
if ($self -> options & ambiguity_is_fatal) |
|
491
|
|
|
|
|
|
|
{ |
|
492
|
|
|
|
|
|
|
# This 'die' is inside try{}catch{}, which adds the prefix 'Error: '. |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
die "$message\n"; |
|
495
|
|
|
|
|
|
|
} |
|
496
|
|
|
|
|
|
|
elsif ($self -> options & print_warnings) |
|
497
|
|
|
|
|
|
|
{ |
|
498
|
|
|
|
|
|
|
$self -> error_number(-2); |
|
499
|
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
print "Warning: $message\n"; |
|
501
|
|
|
|
|
|
|
} |
|
502
|
|
|
|
|
|
|
} |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
my($hex_as_char) = $self -> options & return_hex_as_chars; |
|
505
|
|
|
|
|
|
|
my($long_form) = $self -> options & long_descriptors; |
|
506
|
|
|
|
|
|
|
my($value_ref) = $self -> recce -> value; |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
my(@hex); |
|
509
|
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
if (defined $value_ref) |
|
511
|
|
|
|
|
|
|
{ |
|
512
|
|
|
|
|
|
|
$self -> stack(Set::Array -> new); |
|
513
|
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
my($count) = 0; |
|
515
|
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
my($type); |
|
517
|
|
|
|
|
|
|
my($value); |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
for my $item (@{$self -> decode_result($$value_ref)}) |
|
520
|
|
|
|
|
|
|
{ |
|
521
|
|
|
|
|
|
|
next if (! defined($item) ); |
|
522
|
|
|
|
|
|
|
next if ($item =~ /^[=,; ]$/); |
|
523
|
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
if ($item eq '+') |
|
525
|
|
|
|
|
|
|
{ |
|
526
|
|
|
|
|
|
|
# The 'multivalued' key is use for temporary storage. See _combine(). |
|
527
|
|
|
|
|
|
|
# 'count' holds the count of RDNs within this stack element. |
|
528
|
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
$self -> stack -> push({multivalued => 1}); |
|
530
|
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
next; |
|
532
|
|
|
|
|
|
|
} |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
$count++; |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# This line uses $$item{value}, not $$item{type}! |
|
537
|
|
|
|
|
|
|
# $$item{type} takes these values: |
|
538
|
|
|
|
|
|
|
# Count Type |
|
539
|
|
|
|
|
|
|
# 1 type |
|
540
|
|
|
|
|
|
|
# 2 value |
|
541
|
|
|
|
|
|
|
# 3 type |
|
542
|
|
|
|
|
|
|
# 4 value |
|
543
|
|
|
|
|
|
|
# ... |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
$value = $$item{value}; |
|
546
|
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
if ( ($count % 2) == 1) |
|
548
|
|
|
|
|
|
|
{ |
|
549
|
|
|
|
|
|
|
$type = $long_form && $descriptors{$value} ? $descriptors{$value} : $value; |
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
else |
|
552
|
|
|
|
|
|
|
{ |
|
553
|
|
|
|
|
|
|
if ($hex_as_char && (substr($value, 0, 1) eq '#') ) |
|
554
|
|
|
|
|
|
|
{ |
|
555
|
|
|
|
|
|
|
@hex = (); |
|
556
|
|
|
|
|
|
|
$value = substr($value, 1); |
|
557
|
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
while ($value =~ /(..)/g) |
|
559
|
|
|
|
|
|
|
{ |
|
560
|
|
|
|
|
|
|
push @hex, $1; |
|
561
|
|
|
|
|
|
|
} |
|
562
|
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
$value = join('', map{chr hex} @hex); |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# The 'multivalued' key is use for temporary storage. See _combine(). |
|
567
|
|
|
|
|
|
|
# 'count' holds the count of RDNs within this stack element. |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
$self -> stack -> push({count => 1, multivalued => 0, type => $type, value => $value}); |
|
570
|
|
|
|
|
|
|
} |
|
571
|
|
|
|
|
|
|
} |
|
572
|
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
$self -> _combine; |
|
574
|
|
|
|
|
|
|
} |
|
575
|
|
|
|
|
|
|
else |
|
576
|
|
|
|
|
|
|
{ |
|
577
|
|
|
|
|
|
|
$result = 1; |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
print "Error: Parse failed\n" if ($self -> options & print_errors); |
|
580
|
|
|
|
|
|
|
} |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
catch |
|
583
|
|
|
|
|
|
|
{ |
|
584
|
|
|
|
|
|
|
$result = 1; |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
print "Error: Parse failed. ${_}" if ($self -> options & print_errors); |
|
587
|
|
|
|
|
|
|
}; |
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# Return 0 for success and 1 for failure. |
|
590
|
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
return $result; |
|
592
|
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
} # End of parse. |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub rdn |
|
598
|
|
|
|
|
|
|
{ |
|
599
|
|
|
|
|
|
|
my($self, $n) = @_; |
|
600
|
|
|
|
|
|
|
$n -= 1; |
|
601
|
|
|
|
|
|
|
my(@rdn) = $self -> stack -> print; |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
return ( ($n < 0) || ($n > $#rdn) ) ? '' : "${$rdn[$n]}{type}=${$rdn[$n]}{value}"; |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
} # End of rdn. |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub rdn_count |
|
610
|
|
|
|
|
|
|
{ |
|
611
|
|
|
|
|
|
|
my($self, $n) = @_; |
|
612
|
|
|
|
|
|
|
$n -= 1; |
|
613
|
|
|
|
|
|
|
my(@rdn) = $self -> stack -> print; |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
return ( ($n < 0) || ($n > $#rdn) ) ? 0 : ${$rdn[$n]}{count}; |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
} # End of rdn_count. |
|
618
|
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
620
|
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
sub rdn_number |
|
622
|
|
|
|
|
|
|
{ |
|
623
|
|
|
|
|
|
|
my($self) = @_; |
|
624
|
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
return $self -> stack -> length; |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
} # End of rdn_number. |
|
628
|
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
sub rdn_type |
|
632
|
|
|
|
|
|
|
{ |
|
633
|
|
|
|
|
|
|
my($self, $n) = @_; |
|
634
|
|
|
|
|
|
|
$n -= 1; |
|
635
|
|
|
|
|
|
|
my(@rdn) = $self -> stack -> print; |
|
636
|
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
return ( ($n < 0) || ($n > $#rdn) ) ? '' : ${$rdn[$n]}{type}; |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
} # End of rdn_type. |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub rdn_types |
|
644
|
|
|
|
|
|
|
{ |
|
645
|
|
|
|
|
|
|
my($self, $n) = @_; |
|
646
|
|
|
|
|
|
|
$n -= 1; |
|
647
|
|
|
|
|
|
|
my(@rdn) = $self -> stack -> print; |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
my(@result); |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
return @result if ( ($n < 0) || ($n > $#rdn) ); |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
my(@bits) = split(/\+/, "${$rdn[$n]}{type}=${$rdn[$n]}{value}"); |
|
654
|
|
|
|
|
|
|
my(@parts) = map{split(/=/, $_)} @bits; |
|
655
|
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
for my $i (0 .. $#parts) |
|
657
|
|
|
|
|
|
|
{ |
|
658
|
|
|
|
|
|
|
push @result, $parts[$i] if ( ($i % 2) == 0); |
|
659
|
|
|
|
|
|
|
} |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
return @result; |
|
662
|
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
} # End of rdn_types. |
|
664
|
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
sub rdn_value |
|
668
|
|
|
|
|
|
|
{ |
|
669
|
|
|
|
|
|
|
my($self, $n) = @_; |
|
670
|
|
|
|
|
|
|
$n -= 1; |
|
671
|
|
|
|
|
|
|
my(@rdn) = $self -> stack -> print; |
|
672
|
|
|
|
|
|
|
my($result) = ''; |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
if ( ($n >= 0) && ($n <= $#rdn) ) |
|
675
|
|
|
|
|
|
|
{ |
|
676
|
|
|
|
|
|
|
# This returns '' for an RDN of 'x='. See *::Actions.attribute_value(). |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
$result = ${$rdn[$n]}{value}; |
|
679
|
|
|
|
|
|
|
} |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
return $result; |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
} # End of rdn_value. |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
686
|
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub rdn_values |
|
688
|
|
|
|
|
|
|
{ |
|
689
|
|
|
|
|
|
|
my($self, $type) = @_; |
|
690
|
|
|
|
|
|
|
$type = lc $type; |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
my(@result); |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
for my $rdn ($self -> stack -> print) |
|
695
|
|
|
|
|
|
|
{ |
|
696
|
|
|
|
|
|
|
push @result, $$rdn{value} if ($$rdn{type} eq $type); |
|
697
|
|
|
|
|
|
|
} |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
return @result; |
|
700
|
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
} # End of rdn_values. |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# ------------------------------------------------ |
|
704
|
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
1; |
|
706
|
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=pod |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=encoding utf8 |
|
710
|
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
=head1 NAME |
|
712
|
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
C - Parse X.500 DNs |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=head1 Synopsis |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
#!/usr/bin/env perl |
|
718
|
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
use strict; |
|
720
|
|
|
|
|
|
|
use warnings; |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
use X500::DN::Marpa ':constants'; |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
# ----------- |
|
725
|
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
my(%count) = (fail => 0, success => 0, total => 0); |
|
727
|
|
|
|
|
|
|
my($parser) = X500::DN::Marpa -> new |
|
728
|
|
|
|
|
|
|
( |
|
729
|
|
|
|
|
|
|
options => long_descriptors, |
|
730
|
|
|
|
|
|
|
); |
|
731
|
|
|
|
|
|
|
my(@text) = |
|
732
|
|
|
|
|
|
|
( |
|
733
|
|
|
|
|
|
|
q||, |
|
734
|
|
|
|
|
|
|
q|1.4.9=2001|, |
|
735
|
|
|
|
|
|
|
q|cn=Nemo,c=US|, |
|
736
|
|
|
|
|
|
|
q|cn=Nemo, c=US|, |
|
737
|
|
|
|
|
|
|
q|cn = Nemo, c = US|, |
|
738
|
|
|
|
|
|
|
q|cn=John Doe, o=Acme, c=US|, |
|
739
|
|
|
|
|
|
|
q|cn=John Doe, o=Acme\\, Inc., c=US|, |
|
740
|
|
|
|
|
|
|
q|x= |, |
|
741
|
|
|
|
|
|
|
q|x=\\ |, |
|
742
|
|
|
|
|
|
|
q|x = \\ |, |
|
743
|
|
|
|
|
|
|
q|x=\\ \\ |, |
|
744
|
|
|
|
|
|
|
q|x=\\#\"\\41|, |
|
745
|
|
|
|
|
|
|
q|x=#616263|, |
|
746
|
|
|
|
|
|
|
q|SN=Lu\C4\8Di\C4\87|, # 'Lučić'. |
|
747
|
|
|
|
|
|
|
q|foo=FOO + bar=BAR + frob=FROB, baz=BAZ|, |
|
748
|
|
|
|
|
|
|
q|UID=jsmith,DC=example,DC=net|, |
|
749
|
|
|
|
|
|
|
q|OU=Sales+CN=J. Smith,DC=example,DC=net|, |
|
750
|
|
|
|
|
|
|
q|CN=James \"Jim\" Smith\, III,DC=example,DC=net|, |
|
751
|
|
|
|
|
|
|
q|CN=Before\0dAfter,DC=example,DC=net|, |
|
752
|
|
|
|
|
|
|
q|1.3.6.1.4.1.1466.0=#04024869|, |
|
753
|
|
|
|
|
|
|
q|UID=nobody@example.com,DC=example,DC=com|, |
|
754
|
|
|
|
|
|
|
q|CN=John Smith,OU=Sales,O=ACME Limited,L=Moab,ST=Utah,C=US|, |
|
755
|
|
|
|
|
|
|
); |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
my($result); |
|
758
|
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
for my $text (@text) |
|
760
|
|
|
|
|
|
|
{ |
|
761
|
|
|
|
|
|
|
$count{total}++; |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
print "# $count{total}. Parsing |$text|. \n"; |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
$result = $parser -> parse($text); |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
print "Parse result: $result (0 is success)\n"; |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
if ($result == 0) |
|
770
|
|
|
|
|
|
|
{ |
|
771
|
|
|
|
|
|
|
$count{success}++; |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
for my $item ($parser -> stack -> print) |
|
774
|
|
|
|
|
|
|
{ |
|
775
|
|
|
|
|
|
|
print "$$item{type} = $$item{value}. count = $$item{count}. \n"; |
|
776
|
|
|
|
|
|
|
} |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
print 'DN: ', $parser -> dn, ". \n"; |
|
779
|
|
|
|
|
|
|
print 'OpenSSL DN: ', $parser -> openssl_dn, ". \n"; |
|
780
|
|
|
|
|
|
|
} |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
print '-' x 50, "\n"; |
|
783
|
|
|
|
|
|
|
} |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
$count{fail} = $count{total} - $count{success}; |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
print "\n"; |
|
788
|
|
|
|
|
|
|
print 'Statistics: ', join(', ', map{"$_ => $count{$_}"} sort keys %count), ". \n"; |
|
789
|
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
See scripts/synopsis.pl. |
|
791
|
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
This is part of the printout of synopsis.pl: |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
# 3. Parsing |cn=Nemo,c=US|. |
|
795
|
|
|
|
|
|
|
Parse result: 0 (0 is success) |
|
796
|
|
|
|
|
|
|
commonName = Nemo. count = 1. |
|
797
|
|
|
|
|
|
|
countryName = US. count = 1. |
|
798
|
|
|
|
|
|
|
DN: countryName=US,commonName=Nemo. |
|
799
|
|
|
|
|
|
|
OpenSSL DN: commonName=Nemo+countryName=US. |
|
800
|
|
|
|
|
|
|
-------------------------------------------------- |
|
801
|
|
|
|
|
|
|
... |
|
802
|
|
|
|
|
|
|
-------------------------------------------------- |
|
803
|
|
|
|
|
|
|
# 13. Parsing |x=#616263|. |
|
804
|
|
|
|
|
|
|
Parse result: 0 (0 is success) |
|
805
|
|
|
|
|
|
|
x = #616263. count = 1. |
|
806
|
|
|
|
|
|
|
DN: x=#616263. |
|
807
|
|
|
|
|
|
|
OpenSSL DN: x=#616263. |
|
808
|
|
|
|
|
|
|
-------------------------------------------------- |
|
809
|
|
|
|
|
|
|
... |
|
810
|
|
|
|
|
|
|
-------------------------------------------------- |
|
811
|
|
|
|
|
|
|
# 15. Parsing |foo=FOO + bar=BAR + frob=FROB, baz=BAZ|. |
|
812
|
|
|
|
|
|
|
Parse result: 0 (0 is success) |
|
813
|
|
|
|
|
|
|
foo = FOO+bar=BAR+frob=FROB. count = 3. |
|
814
|
|
|
|
|
|
|
baz = BAZ. count = 1. |
|
815
|
|
|
|
|
|
|
DN: baz=BAZ,foo=FOO+bar=BAR+frob=FROB. |
|
816
|
|
|
|
|
|
|
OpenSSL DN: foo=FOO+bar=BAR+frob=FROB+baz=BAZ. |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
If you set the option C, as discussed in the L, then case 13 will print: |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
# 13. Parsing |x=#616263|. |
|
821
|
|
|
|
|
|
|
Parse result: 0 (0 is success) |
|
822
|
|
|
|
|
|
|
x = abc. count = 1. |
|
823
|
|
|
|
|
|
|
DN: x=abc. |
|
824
|
|
|
|
|
|
|
OpenSSL DN: x=abc. |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=head1 Description |
|
827
|
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
C provides a L-based parser for parsing X.500 Distinguished Names. |
|
829
|
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
It is based on L: |
|
831
|
|
|
|
|
|
|
Lightweight Directory Access Protocol (LDAP): String Representation of Distinguished Names. |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head1 Distributions |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
This module is available as a Unix-style distro (*.tgz). |
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
See L |
|
838
|
|
|
|
|
|
|
for help on unpacking and installing distros. |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=head1 Installation |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
Install C as you would any C module: |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
Run: |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
cpanm X500::DN::Marpa |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
or run: |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
sudo cpan X500::DN::Marpa |
|
851
|
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
or unpack the distro, and then either: |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
perl Build.PL |
|
855
|
|
|
|
|
|
|
./Build |
|
856
|
|
|
|
|
|
|
./Build test |
|
857
|
|
|
|
|
|
|
sudo ./Build install |
|
858
|
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
or: |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
perl Makefile.PL |
|
862
|
|
|
|
|
|
|
make (or dmake or nmake) |
|
863
|
|
|
|
|
|
|
make test |
|
864
|
|
|
|
|
|
|
make install |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=head1 Constructor and Initialization |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
C is called as C<< my($parser) = X500::DN::Marpa -> new(k1 => v1, k2 => v2, ...) >>. |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
It returns a new object of type C. |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
Key-value pairs accepted in the parameter list (see corresponding methods for details |
|
873
|
|
|
|
|
|
|
[e.g. L]): |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=over 4 |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=item o options => $bit_string |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
This allows you to turn on various options. |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Default: 0 (nothing is fatal). |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
See the L for details. |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item o text => $a_string_to_be_parsed |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Default: ''. |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=back |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head1 Methods |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=head2 bnf() |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Returns a string containing the grammar used by this module. |
|
896
|
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
=head2 dn() |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Returns the RDNs, separated by commas, as a single string in the reverse order compared with the |
|
900
|
|
|
|
|
|
|
order of the RNDs in the input text. |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
The order reversal is discussed in section 2.1 of L. |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
Hence 'cn=Nemo, c=US' is returned as 'countryName=US,commonName=Nemo' (when the |
|
905
|
|
|
|
|
|
|
C option is used), and as 'c=US,cn=Nemo' by default. |
|
906
|
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
See also L. |
|
908
|
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=head2 error_message() |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
Returns the last error or warning message set. |
|
912
|
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
Error messages always start with 'Error: '. Messages never end with "\n". |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
Parsing error strings is not a good idea, ever though this module's format for them is fixed. |
|
916
|
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
See L. |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head2 error_number() |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
Returns the last error or warning number set. |
|
922
|
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
Warnings have values < 0, and errors have values > 0. |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
If the value is > 0, the message has the prefix 'Error: ', and if the value is < 0, it has the |
|
926
|
|
|
|
|
|
|
prefix 'Warning: '. If this is not the case, it's a reportable bug. |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
Possible values for error_number() and error_message(): |
|
929
|
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=over 4 |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=item o 0 => "" |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
This is the default value. |
|
935
|
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
=item o 1/-1 => "Parse exhausted" |
|
937
|
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
If L returns 1, it's an error, and if it returns -1 it's a warning. |
|
939
|
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
You can set the option C to make it fatal. |
|
941
|
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=item o 2/-2 => "Ambiguous parse. Status: $status. Terminals expected: a, b, ..." |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
This message is only produced when the parse is ambiguous. |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
If L returns 2, it's an error, and if it returns -2 it's a warning. |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
You can set the option C to make it fatal. |
|
949
|
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
=back |
|
951
|
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
See L. |
|
953
|
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=head2 new() |
|
955
|
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
See L for details on the parameters accepted by L. |
|
957
|
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head2 openssl_dn() |
|
959
|
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Returns the RDNs, separated by pluses, as a single string in the same order compared with the |
|
961
|
|
|
|
|
|
|
order of the RNDs in the input text. |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
Hence 'cn=Nemo, c=US' is returned as 'commonName=Nemo+countryName=US' (when the |
|
964
|
|
|
|
|
|
|
C option is used), and as 'cn=Nemo+c=US' by default. |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
See also L. |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=head2 options([$bit_string]) |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
Get or set the option flags. |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
For typical usage, see scripts/synopsis.pl. |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
See the L for details. |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
'options' is a parameter to L. See L for details. |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=head2 parse([$string]) |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
This is the only method the user needs to call. All data can be supplied when calling L. |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
You can of course call other methods (e.g. L ) after calling L but |
|
987
|
|
|
|
|
|
|
before calling C. |
|
988
|
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
Note: If a string is passed to C, it takes precedence over any string passed to |
|
990
|
|
|
|
|
|
|
C<< new(text => $string) >>, and over any string passed to L. Further, |
|
991
|
|
|
|
|
|
|
the string passed to C is passed to L, meaning any subsequent |
|
992
|
|
|
|
|
|
|
call to C returns the string passed to C. |
|
993
|
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
See scripts/synopsis.pl. |
|
995
|
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Returns 0 for success and 1 for failure. |
|
997
|
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
If the value is 1, you should call L to find out what happened. |
|
999
|
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=head2 rdn($n) |
|
1001
|
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
Returns a string containing the $n-th RDN, or returns '' if $n is out of range. |
|
1003
|
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
$n counts from 1. |
|
1005
|
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns |
|
1007
|
|
|
|
|
|
|
'uid=nobody@example.com'. Note the lower-case 'uid'. |
|
1008
|
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
See t/dn.t. |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
=head2 rdn_count($n) |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
Returns a string containing the $n-th RDN's count (multivalue indicator), or returns 0 if $n is out |
|
1014
|
|
|
|
|
|
|
of range. |
|
1015
|
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
$n counts from 1. |
|
1017
|
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns 1. |
|
1019
|
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
If the input is 'foo=FOO+bar=BAR+frob=FROB, baz=BAZ', C returns 3. |
|
1021
|
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
Not to be confused with L. |
|
1023
|
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
See t/dn.t. |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head2 rdn_number() |
|
1027
|
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Returns the number of RDNs, which may be 0. |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns 3. |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
Not to be confused with L. |
|
1033
|
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
See t/dn.t. |
|
1035
|
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=head2 rdn_type($n) |
|
1037
|
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
Returns a string containing the $n-th RDN's attribute type, or returns '' if $n is out of range. |
|
1039
|
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
$n counts from 1. |
|
1041
|
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns 'uid'. |
|
1043
|
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
See t/dn.t. |
|
1045
|
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
=head2 rdn_types($n) |
|
1047
|
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
Returns an array containing all the types of all the RDNs for the given RDN, or returns () if $n is |
|
1049
|
|
|
|
|
|
|
out of range. |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
$n counts from 1. |
|
1052
|
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
If the DN is 'foo=FOO+bar=BAR+frob=FROB, baz=BAZ', C returns ('foo', 'bar', frob'). |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
See t/dn.t. |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=head2 rdn_value($n) |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
Returns a string containing the $n-th RDN's attribute value, or returns '' if $n is out of |
|
1060
|
|
|
|
|
|
|
range. |
|
1061
|
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
$n counts from 1. |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns |
|
1065
|
|
|
|
|
|
|
'nobody@example.com'. |
|
1066
|
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
See t/dn.t. |
|
1068
|
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
=head2 rdn_values($type) |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
Returns an array containing the RDN attribute values for the attribute type $type, or (). |
|
1072
|
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', C returns |
|
1074
|
|
|
|
|
|
|
('example', 'com'). |
|
1075
|
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
See t/dn.t. |
|
1077
|
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head2 stack() |
|
1079
|
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
Returns an object of type L, which holds the parsed data. |
|
1081
|
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
Obviously, it only makes sense to call C after calling L. |
|
1083
|
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
The structure of elements in this stack is documented in the L. |
|
1085
|
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
See scripts/tiny.pl for sample code. |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=head2 text([$string]) |
|
1089
|
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
Get or set a string to be parsed. |
|
1093
|
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
'text' is a parameter to L. See L for details. |
|
1095
|
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
=head1 FAQ |
|
1097
|
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=head2 Where are the error messages and numbers described? |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
See L and L. |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
See also L below. |
|
1103
|
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
=head2 What is the structure in RAM of the parsed data? |
|
1105
|
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
The module outputs a stack, which is an object of type L. See L. |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
Elements in this stack are in the same order as the RDNs are in the input string. |
|
1109
|
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
The L method returns the RDNs, separated by commas, as a single string in the reverse order, |
|
1111
|
|
|
|
|
|
|
whereas L separates them by pluses and uses the original order. |
|
1112
|
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
Each element of this stack is a hashref, with these (key => value) pairs: |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
=over 4 |
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=item o count => $number |
|
1118
|
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
The number of attribute types and values in a (possibly multivalued) RDN. |
|
1120
|
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
$number counts from 1. |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=item o type => $type |
|
1124
|
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
The attribute type. |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=item o value => $value |
|
1128
|
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
The attribute value. |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
=back |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
Sample DNs: |
|
1134
|
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
Note: These examples assume the default case of the option C (discussed below) |
|
1136
|
|
|
|
|
|
|
I being used. |
|
1137
|
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
If the input is 'UID=nobody@example.com,DC=example,DC=com', the stack will contain: |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=over 4 |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=item o [0]: {count => 1, type => 'uid', value => 'nobody@example.com'} |
|
1143
|
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item o [1]: {count => 1, type => 'dc', value => 'example'} |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=item o [2]: {count => 1, type => 'dc', value => 'com'} |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=back |
|
1149
|
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
If the input is 'foo=FOO+bar=BAR+frob=FROB, baz=BAZ', the stack will contain: |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=over 4 |
|
1153
|
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=item o [0]: {count => 3, type => 'foo', value => 'FOO+bar=BAR+frob=FROB'} |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=item o [1]: {count => 1, type => 'baz', value => 'BAZ'} |
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=back |
|
1159
|
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
Sample Code: |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
A typical script uses code like this (copied from scripts/tiny.pl): |
|
1163
|
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
$result = $parser -> parse($text); |
|
1165
|
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
print "Parse result: $result (0 is success)\n"; |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
if ($result == 0) |
|
1169
|
|
|
|
|
|
|
{ |
|
1170
|
|
|
|
|
|
|
for my $item ($parser -> stack -> print) |
|
1171
|
|
|
|
|
|
|
{ |
|
1172
|
|
|
|
|
|
|
print "$$item{type} = $$item{value}. count = $$item{count}. \n"; |
|
1173
|
|
|
|
|
|
|
} |
|
1174
|
|
|
|
|
|
|
} |
|
1175
|
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
If the option C is I used in the call to L, then $$item{type} |
|
1177
|
|
|
|
|
|
|
defaults to lower-case. L says 'Short names are case |
|
1178
|
|
|
|
|
|
|
insensitive....'. I've chosen to use lower-case as the canonical form output by my code. |
|
1179
|
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
If that option I used, then some types are output in mixed case. The list of such types is given |
|
1181
|
|
|
|
|
|
|
in section 3 (at the top of page 6) in L. This |
|
1182
|
|
|
|
|
|
|
document is one of those listed in L, below. |
|
1183
|
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
For a discussion of the mixed-case descriptors, see |
|
1185
|
|
|
|
|
|
|
L below. |
|
1186
|
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
An extended list of such long descriptors is given in section 4 (page 25) in |
|
1188
|
|
|
|
|
|
|
L. Note that 'streetAddress' is missing from this |
|
1189
|
|
|
|
|
|
|
list. |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
=head2 What are the possible values for the 'options' parameter to new()? |
|
1192
|
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
Firstly, to make these constants available, you must say: |
|
1194
|
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
use X500::DN::Marpa ':constants'; |
|
1196
|
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
Secondly, more detail on errors and warnings can be found at L. |
|
1198
|
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
Thirdly, for usage of these option flags, see scripts/synopsis.pl and scripts/tiny.pl. |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
Now the flags themselves: |
|
1202
|
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
=over 4 |
|
1204
|
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
=item o nothing_is_fatal |
|
1206
|
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
This is the default. |
|
1208
|
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
C has the value of 0. |
|
1210
|
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
=item o print_errors |
|
1212
|
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
Print error messages if this flag is set. |
|
1214
|
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
C has the value of 1. |
|
1216
|
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
=item o print_warnings |
|
1218
|
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
Print various warnings if this flag is set: |
|
1220
|
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
=over 4 |
|
1222
|
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
=item o The ambiguity status and terminals expected, if the parse is ambiguous |
|
1224
|
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
=item o See L for other warnings which might be printed |
|
1226
|
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
Ambiguity is not, in and of itself, an error. But see the C option, below. |
|
1228
|
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
=back |
|
1230
|
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
It's tempting to call this option C, but Perl already has C |
|
1232
|
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
C has the value of 2. |
|
1234
|
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
=item o print_debugs |
|
1236
|
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
Print extra stuff if this flag is set. |
|
1238
|
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
C has the value of 4. |
|
1240
|
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
=item o ambiguity_is_fatal |
|
1242
|
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
This makes L return 2 rather than -2. |
|
1244
|
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
C has the value of 8. |
|
1246
|
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
=item o exhaustion_is_fatal |
|
1248
|
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
This makes L return 1 rather than -1. |
|
1250
|
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
C has the value of 16. |
|
1252
|
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
=item o long_descriptors |
|
1254
|
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
This makes the C key in the output stack's elements contain long descriptor names rather than |
|
1256
|
|
|
|
|
|
|
abbreviations. |
|
1257
|
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
For example, if the input was 'cn=Nemo,c=US', the output stack would contain, I, i.e. |
|
1259
|
|
|
|
|
|
|
without setting this option: |
|
1260
|
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
=over 4 |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
=item o [0]: {count => 1, type => 'cn', value => 'Nemo'} |
|
1264
|
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=item o [1]: {count => 1, type => 'c', value => 'US'} |
|
1266
|
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
=back |
|
1268
|
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
However, if this option is set, the output will contain: |
|
1270
|
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
=over 4 |
|
1272
|
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
=item o [0]: {count => 1, type => 'commonName', value => 'Nemo'} |
|
1274
|
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
=item o [1]: {count => 1, type => 'countryName', value => 'US'} |
|
1276
|
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
=back |
|
1278
|
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
C has the value of 32. |
|
1280
|
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
=item o return_hex_as_chars |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
This triggers extra processing of attribute values which start with '#': |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
=over 4 |
|
1286
|
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
=item o The value is assumed to consist entirely of hex digits (after the '#' is discarded) |
|
1288
|
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
=item o The digits are converted 2 at-a-time into a string of (presumably ASCII) characters |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
=item o These characters are concatenated into a single string, which becomes the new value |
|
1292
|
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
=back |
|
1294
|
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
So, if this option is I used, 'x=#616263' is parsed as {type => 'x', value => '#616263'}, |
|
1296
|
|
|
|
|
|
|
but if the option I used, you get {type => 'x', value => 'abc'}. |
|
1297
|
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
C has the value of 64. |
|
1299
|
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=back |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
=head2 Does this package support Unicode/UTF8? |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
Handling of UTF8 is discussed in one of the RFCs listed in L, below. |
|
1305
|
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=head2 What is the homepage of Marpa? |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
L. |
|
1309
|
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
That page has a long list of links. |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
=head2 How do I run author tests? |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
This runs both standard and author tests: |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
shell> perl Build.PL; ./Build; ./Build authortest |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
=head1 References |
|
1319
|
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
I found RFCs 4514 and 4512 to be the most directly relevant ones. |
|
1321
|
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
L: The Index. Just search for 'LDAP'. |
|
1323
|
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
L: |
|
1325
|
|
|
|
|
|
|
Lightweight Directory Access Protocol (LDAP): String Representation of Distinguished Names. |
|
1326
|
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
L: |
|
1328
|
|
|
|
|
|
|
Lightweight Directory Access Protocol (LDAP): Directory Information Models. |
|
1329
|
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
L: |
|
1331
|
|
|
|
|
|
|
Lightweight Directory Access Protocol (LDAP): Syntaxes and Matching Rules. |
|
1332
|
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
L: |
|
1334
|
|
|
|
|
|
|
Augmented BNF for Syntax Specifications: ABNF. |
|
1335
|
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
L: UTF-8, a transformation format of ISO 10646. |
|
1337
|
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
RFC4514 also discusses UTF8. Search it using the string 'UTF-8'. |
|
1339
|
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
=head1 See Also |
|
1341
|
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
L. Note: This module is based on the obsolete |
|
1343
|
|
|
|
|
|
|
L. |
|
1344
|
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
=head1 Machine-Readable Change Log |
|
1346
|
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
The file Changes was converted into Changelog.ini by L. |
|
1348
|
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=head1 Version Numbers |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions. |
|
1352
|
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
=head1 Repository |
|
1354
|
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
L |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=head1 Support |
|
1358
|
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
Email the author, or log a bug on RT: |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
L. |
|
1362
|
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
=head1 Author |
|
1364
|
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
L was written by Ron Savage Iron@savage.net.auE> in 2015. |
|
1366
|
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
Marpa's homepage: L. |
|
1368
|
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
My homepage: L. |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
=head1 Copyright |
|
1372
|
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
Australian copyright (c) 2015, Ron Savage. |
|
1374
|
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
All Programs of mine are 'OSI Certified Open Source Software'; |
|
1376
|
|
|
|
|
|
|
you can redistribute them and/or modify them under the terms of |
|
1377
|
|
|
|
|
|
|
The Artistic License 2.0, a copy of which is available at: |
|
1378
|
|
|
|
|
|
|
http://opensource.org/licenses/alphabetical. |
|
1379
|
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
=cut |