line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package X500::DN::Marpa; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
27279
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
62
|
|
4
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
102
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
|
|
25
|
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
|
|
1701
|
]; |
|
2
|
|
|
|
|
42494
|
|
17
|
|
|
|
|
|
|
|
18
|
2
|
|
|
2
|
|
2884
|
use Marpa::R2; |
|
2
|
|
|
|
|
378658
|
|
|
2
|
|
|
|
|
96
|
|
19
|
|
|
|
|
|
|
|
20
|
2
|
|
|
2
|
|
4654
|
use Moo; |
|
2
|
|
|
|
|
22092
|
|
|
2
|
|
|
|
|
13
|
|
21
|
|
|
|
|
|
|
|
22
|
2
|
|
|
2
|
|
6107
|
use Set::Array; |
|
2
|
|
|
|
|
25666
|
|
|
2
|
|
|
|
|
81
|
|
23
|
|
|
|
|
|
|
|
24
|
2
|
|
|
2
|
|
1974
|
use Types::Standard qw/Any Int Str/; |
|
2
|
|
|
|
|
138054
|
|
|
2
|
|
|
|
|
24
|
|
25
|
|
|
|
|
|
|
|
26
|
2
|
|
|
2
|
|
2042
|
use Try::Tiny; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
135
|
|
27
|
|
|
|
|
|
|
|
28
|
2
|
|
|
2
|
|
1200
|
use X500::DN::Marpa::Actions; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
5075
|
|
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 = '1.00'; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# ------------------------------------------------ |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub BUILD |
116
|
|
|
|
|
|
|
{ |
117
|
5
|
|
|
5
|
0
|
143
|
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
|
5
|
|
|
|
|
12
|
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
|
5
|
|
|
|
|
82
|
$self -> bnf($bnf); |
318
|
5
|
|
|
|
|
1389
|
$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
|
30
|
|
|
30
|
0
|
52
|
my($self, $result) = @_; |
333
|
30
|
|
|
|
|
82
|
my(@worklist) = $result; |
334
|
|
|
|
|
|
|
|
335
|
30
|
|
|
|
|
49
|
my($obj); |
336
|
|
|
|
|
|
|
my($ref_type); |
337
|
0
|
|
|
|
|
0
|
my(@stack); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
do |
340
|
30
|
|
|
|
|
62
|
{ |
341
|
668
|
|
|
|
|
891
|
$obj = shift @worklist; |
342
|
668
|
|
|
|
|
878
|
$ref_type = ref $obj; |
343
|
|
|
|
|
|
|
|
344
|
668
|
100
|
|
|
|
1520
|
if ($ref_type eq 'ARRAY') |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
345
|
|
|
|
|
|
|
{ |
346
|
409
|
|
|
|
|
1151
|
unshift @worklist, @$obj; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
elsif ($ref_type eq 'HASH') |
349
|
|
|
|
|
|
|
{ |
350
|
132
|
|
|
|
|
649
|
push @stack, {%$obj}; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
elsif ($ref_type) |
353
|
|
|
|
|
|
|
{ |
354
|
0
|
|
|
|
|
0
|
die "Unsupported object type $ref_type\n"; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
else |
357
|
|
|
|
|
|
|
{ |
358
|
127
|
|
|
|
|
402
|
push @stack, $obj; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
} while (@worklist); |
362
|
|
|
|
|
|
|
|
363
|
30
|
|
|
|
|
160
|
return [@stack]; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
} # End of decode_result. |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# ------------------------------------------------ |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub _combine |
370
|
|
|
|
|
|
|
{ |
371
|
30
|
|
|
30
|
|
73
|
my($self) = @_; |
372
|
30
|
|
|
|
|
753
|
my(@temp) = $self -> stack -> print; |
373
|
30
|
|
|
|
|
587
|
my($multivalued) = 0; |
374
|
|
|
|
|
|
|
|
375
|
30
|
|
|
|
|
42
|
my(@dn); |
376
|
|
|
|
|
|
|
|
377
|
30
|
|
|
|
|
106
|
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
|
73
|
100
|
|
|
|
219
|
if ($temp[$i]{multivalued}) |
|
|
100
|
|
|
|
|
|
383
|
|
|
|
|
|
|
{ |
384
|
7
|
|
|
|
|
22
|
$multivalued = 1; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
elsif ($multivalued) |
387
|
|
|
|
|
|
|
{ |
388
|
7
|
|
|
|
|
10
|
$multivalued = 0; |
389
|
7
|
|
|
|
|
15
|
$dn[$#dn]{count} += 1; |
390
|
7
|
|
|
|
|
32
|
$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
|
59
|
|
|
|
|
109
|
undef $temp[$i]{multivalued}; |
397
|
|
|
|
|
|
|
|
398
|
59
|
|
|
|
|
187
|
push @dn, $temp[$i]; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
30
|
|
|
|
|
109
|
$self -> stack(Set::Array -> new(@dn) ); |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
} # End of _combine. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# ------------------------------------------------ |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub dn |
409
|
|
|
|
|
|
|
{ |
410
|
25
|
|
|
25
|
1
|
12533
|
my($self) = @_; |
411
|
|
|
|
|
|
|
|
412
|
25
|
|
|
|
|
45
|
return join(',', map{"$$_{type}=$$_{value}"} reverse @{$self -> stack}); |
|
47
|
|
|
|
|
366
|
|
|
25
|
|
|
|
|
749
|
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
} # End of dn. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# ------------------------------------------------ |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
sub openssl_dn |
419
|
|
|
|
|
|
|
{ |
420
|
25
|
|
|
25
|
1
|
391
|
my($self) = @_; |
421
|
|
|
|
|
|
|
|
422
|
25
|
|
|
|
|
49
|
return join('+', map{"$$_{type}=$$_{value}"} @{$self -> stack}); |
|
47
|
|
|
|
|
305
|
|
|
25
|
|
|
|
|
581
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
} # End of openssl_dn. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# ------------------------------------------------ |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub parse |
429
|
|
|
|
|
|
|
{ |
430
|
31
|
|
|
31
|
1
|
322549
|
my($self, $string) = @_; |
431
|
31
|
50
|
|
|
|
931
|
$self -> text($string) if (defined $string); |
432
|
|
|
|
|
|
|
|
433
|
31
|
|
|
|
|
2623
|
$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
|
31
|
|
|
|
|
14200
|
my($result) = 0; |
447
|
|
|
|
|
|
|
|
448
|
31
|
|
|
|
|
55
|
my($message); |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
try |
451
|
|
|
|
|
|
|
{ |
452
|
31
|
|
|
31
|
|
2030
|
my($text) = $self -> text; |
453
|
31
|
|
|
|
|
222
|
my($text_length) = length($text); |
454
|
31
|
|
|
|
|
662
|
my($read_length) = $self -> recce -> read(\$text); |
455
|
|
|
|
|
|
|
|
456
|
31
|
50
|
|
|
|
32550
|
if ($text_length != $read_length) |
457
|
|
|
|
|
|
|
{ |
458
|
0
|
|
|
|
|
0
|
die "Text is $text_length characters, but read() only read $read_length characters. \n"; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
31
|
50
|
|
|
|
813
|
if ($self -> recce -> exhausted) |
|
|
100
|
|
|
|
|
|
462
|
|
|
|
|
|
|
{ |
463
|
0
|
|
|
|
|
0
|
$message = 'Parse exhausted'; |
464
|
|
|
|
|
|
|
|
465
|
0
|
|
|
|
|
0
|
$self -> error_message($message); |
466
|
0
|
|
|
|
|
0
|
$self -> error_number(1); |
467
|
|
|
|
|
|
|
|
468
|
0
|
0
|
|
|
|
0
|
if ($self -> options & exhaustion_is_fatal) |
469
|
|
|
|
|
|
|
{ |
470
|
|
|
|
|
|
|
# This 'die' is inside try{}catch{}, which adds the prefix 'Error: '. |
471
|
|
|
|
|
|
|
|
472
|
0
|
|
|
|
|
0
|
die "$message\n"; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
else |
475
|
|
|
|
|
|
|
{ |
476
|
0
|
|
|
|
|
0
|
$self -> error_number(-1); |
477
|
|
|
|
|
|
|
|
478
|
0
|
0
|
|
|
|
0
|
print "Warning: $message\n" if ($self -> options & print_warnings); |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
elsif (my $status = $self -> recce -> ambiguous) |
482
|
|
|
|
|
|
|
{ |
483
|
1
|
|
|
|
|
113
|
my($terminals) = $self -> recce -> terminals_expected; |
484
|
1
|
50
|
|
|
|
83
|
$terminals = ['(None)'] if ($#$terminals < 0); |
485
|
1
|
|
|
|
|
6
|
$message = "Ambiguous parse. Status: $status. Terminals expected: " . join(', ', @$terminals); |
486
|
|
|
|
|
|
|
|
487
|
1
|
|
|
|
|
5
|
$self -> error_message($message); |
488
|
1
|
|
|
|
|
623
|
$self -> error_number(2); |
489
|
|
|
|
|
|
|
|
490
|
1
|
50
|
|
|
|
641
|
if ($self -> options & ambiguity_is_fatal) |
|
|
50
|
|
|
|
|
|
491
|
|
|
|
|
|
|
{ |
492
|
|
|
|
|
|
|
# This 'die' is inside try{}catch{}, which adds the prefix 'Error: '. |
493
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
0
|
die "$message\n"; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
elsif ($self -> options & print_warnings) |
497
|
|
|
|
|
|
|
{ |
498
|
0
|
|
|
|
|
0
|
$self -> error_number(-2); |
499
|
|
|
|
|
|
|
|
500
|
0
|
|
|
|
|
0
|
print "Warning: $message\n"; |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
31
|
|
|
|
|
5174
|
my($hex_as_char) = $self -> options & return_hex_as_chars; |
505
|
31
|
|
|
|
|
1554
|
my($long_form) = $self -> options & long_descriptors; |
506
|
31
|
|
|
|
|
830
|
my($value_ref) = $self -> recce -> value; |
507
|
|
|
|
|
|
|
|
508
|
31
|
|
|
|
|
28873
|
my(@hex); |
509
|
|
|
|
|
|
|
|
510
|
31
|
100
|
|
|
|
106
|
if (defined $value_ref) |
511
|
|
|
|
|
|
|
{ |
512
|
30
|
|
|
|
|
220
|
$self -> stack(Set::Array -> new); |
513
|
|
|
|
|
|
|
|
514
|
30
|
|
|
|
|
3345
|
my($count) = 0; |
515
|
|
|
|
|
|
|
|
516
|
30
|
|
|
|
|
63
|
my($type); |
517
|
|
|
|
|
|
|
my($value); |
518
|
|
|
|
|
|
|
|
519
|
30
|
|
|
|
|
53
|
for my $item (@{$self -> decode_result($$value_ref)}) |
|
30
|
|
|
|
|
127
|
|
520
|
|
|
|
|
|
|
{ |
521
|
259
|
50
|
|
|
|
3298
|
next if (! defined($item) ); |
522
|
259
|
100
|
|
|
|
826
|
next if ($item =~ /^[=,; ]$/); |
523
|
|
|
|
|
|
|
|
524
|
139
|
100
|
|
|
|
371
|
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
|
7
|
|
|
|
|
307
|
$self -> stack -> push({multivalued => 1}); |
530
|
|
|
|
|
|
|
|
531
|
7
|
|
|
|
|
402
|
next; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
132
|
|
|
|
|
175
|
$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
|
132
|
|
|
|
|
236
|
$value = $$item{value}; |
546
|
|
|
|
|
|
|
|
547
|
132
|
100
|
|
|
|
325
|
if ( ($count % 2) == 1) |
548
|
|
|
|
|
|
|
{ |
549
|
66
|
50
|
33
|
|
|
249
|
$type = $long_form && $descriptors{$value} ? $descriptors{$value} : $value; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
else |
552
|
|
|
|
|
|
|
{ |
553
|
66
|
100
|
100
|
|
|
329
|
if ($hex_as_char && (substr($value, 0, 1) eq '#') ) |
554
|
|
|
|
|
|
|
{ |
555
|
1
|
|
|
|
|
4
|
@hex = (); |
556
|
1
|
|
|
|
|
3
|
$value = substr($value, 1); |
557
|
|
|
|
|
|
|
|
558
|
1
|
|
|
|
|
7
|
while ($value =~ /(..)/g) |
559
|
|
|
|
|
|
|
{ |
560
|
3
|
|
|
|
|
12
|
push @hex, $1; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
1
|
|
|
|
|
3
|
$value = join('', map{chr hex} @hex); |
|
3
|
|
|
|
|
11
|
|
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
|
66
|
|
|
|
|
1452
|
$self -> stack -> push({count => 1, multivalued => 0, type => $type, value => $value}); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
30
|
|
|
|
|
2227
|
$self -> _combine; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
else |
576
|
|
|
|
|
|
|
{ |
577
|
1
|
|
|
|
|
2
|
$result = 1; |
578
|
|
|
|
|
|
|
|
579
|
1
|
50
|
|
|
|
24
|
print "Error: Parse failed\n" if ($self -> options & print_errors); |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
catch |
583
|
|
|
|
|
|
|
{ |
584
|
0
|
|
|
0
|
|
0
|
$result = 1; |
585
|
|
|
|
|
|
|
|
586
|
0
|
0
|
|
|
|
0
|
print "Error: Parse failed. ${_}" if ($self -> options & print_errors); |
587
|
31
|
|
|
|
|
442
|
}; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# Return 0 for success and 1 for failure. |
590
|
|
|
|
|
|
|
|
591
|
31
|
|
|
|
|
3029
|
return $result; |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
} # End of parse. |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# ------------------------------------------------ |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
sub rdn |
598
|
|
|
|
|
|
|
{ |
599
|
25
|
|
|
25
|
1
|
168
|
my($self, $n) = @_; |
600
|
25
|
|
|
|
|
53
|
$n -= 1; |
601
|
25
|
|
|
|
|
815
|
my(@rdn) = $self -> stack -> print; |
602
|
|
|
|
|
|
|
|
603
|
25
|
100
|
66
|
|
|
558
|
return ( ($n < 0) || ($n > $#rdn) ) ? '' : "${$rdn[$n]}{type}=${$rdn[$n]}{value}"; |
|
24
|
|
|
|
|
90
|
|
|
24
|
|
|
|
|
94
|
|
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
} # End of rdn. |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
# ------------------------------------------------ |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub rdn_count |
610
|
|
|
|
|
|
|
{ |
611
|
22
|
|
|
22
|
1
|
102
|
my($self, $n) = @_; |
612
|
22
|
|
|
|
|
39
|
$n -= 1; |
613
|
22
|
|
|
|
|
469
|
my(@rdn) = $self -> stack -> print; |
614
|
|
|
|
|
|
|
|
615
|
22
|
100
|
66
|
|
|
364
|
return ( ($n < 0) || ($n > $#rdn) ) ? 0 : ${$rdn[$n]}{count}; |
|
21
|
|
|
|
|
70
|
|
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
} # End of rdn_count. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
# ------------------------------------------------ |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
sub rdn_number |
622
|
|
|
|
|
|
|
{ |
623
|
25
|
|
|
25
|
1
|
98
|
my($self) = @_; |
624
|
|
|
|
|
|
|
|
625
|
25
|
|
|
|
|
587
|
return $self -> stack -> length; |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
} # End of rdn_number. |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# ------------------------------------------------ |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
sub rdn_type |
632
|
|
|
|
|
|
|
{ |
633
|
22
|
|
|
22
|
1
|
1816
|
my($self, $n) = @_; |
634
|
22
|
|
|
|
|
38
|
$n -= 1; |
635
|
22
|
|
|
|
|
499
|
my(@rdn) = $self -> stack -> print; |
636
|
|
|
|
|
|
|
|
637
|
22
|
100
|
66
|
|
|
363
|
return ( ($n < 0) || ($n > $#rdn) ) ? '' : ${$rdn[$n]}{type}; |
|
21
|
|
|
|
|
85
|
|
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
} # End of rdn_type. |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# ------------------------------------------------ |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub rdn_types |
644
|
|
|
|
|
|
|
{ |
645
|
26
|
|
|
26
|
1
|
113
|
my($self, $n) = @_; |
646
|
26
|
|
|
|
|
38
|
$n -= 1; |
647
|
26
|
|
|
|
|
571
|
my(@rdn) = $self -> stack -> print; |
648
|
|
|
|
|
|
|
|
649
|
26
|
|
|
|
|
304
|
my(@result); |
650
|
|
|
|
|
|
|
|
651
|
26
|
100
|
66
|
|
|
158
|
return @result if ( ($n < 0) || ($n > $#rdn) ); |
652
|
|
|
|
|
|
|
|
653
|
25
|
|
|
|
|
46
|
my(@bits) = split(/\+/, "${$rdn[$n]}{type}=${$rdn[$n]}{value}"); |
|
25
|
|
|
|
|
71
|
|
|
25
|
|
|
|
|
97
|
|
654
|
25
|
|
|
|
|
97
|
my(@parts) = map{split(/=/, $_)} @bits; |
|
32
|
|
|
|
|
117
|
|
655
|
|
|
|
|
|
|
|
656
|
25
|
|
|
|
|
87
|
for my $i (0 .. $#parts) |
657
|
|
|
|
|
|
|
{ |
658
|
62
|
100
|
|
|
|
212
|
push @result, $parts[$i] if ( ($i % 2) == 0); |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
25
|
|
|
|
|
125
|
return @result; |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
} # End of rdn_types. |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# ------------------------------------------------ |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
sub rdn_value |
668
|
|
|
|
|
|
|
{ |
669
|
22
|
|
|
22
|
1
|
107
|
my($self, $n) = @_; |
670
|
22
|
|
|
|
|
42
|
$n -= 1; |
671
|
22
|
|
|
|
|
515
|
my(@rdn) = $self -> stack -> print; |
672
|
22
|
|
|
|
|
278
|
my($result) = ''; |
673
|
|
|
|
|
|
|
|
674
|
22
|
100
|
66
|
|
|
121
|
if ( ($n >= 0) && ($n <= $#rdn) ) |
675
|
|
|
|
|
|
|
{ |
676
|
|
|
|
|
|
|
# This returns '' for an RDN of 'x='. See *::Actions.attribute_value(). |
677
|
|
|
|
|
|
|
|
678
|
21
|
|
|
|
|
31
|
$result = ${$rdn[$n]}{value}; |
|
21
|
|
|
|
|
62
|
|
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
22
|
|
|
|
|
67
|
return $result; |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
} # End of rdn_value. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# ------------------------------------------------ |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub rdn_values |
688
|
|
|
|
|
|
|
{ |
689
|
33
|
|
|
33
|
1
|
2427
|
my($self, $type) = @_; |
690
|
33
|
|
|
|
|
67
|
$type = lc $type; |
691
|
|
|
|
|
|
|
|
692
|
33
|
|
|
|
|
59
|
my(@result); |
693
|
|
|
|
|
|
|
|
694
|
33
|
|
|
|
|
888
|
for my $rdn ($self -> stack -> print) |
695
|
|
|
|
|
|
|
{ |
696
|
87
|
100
|
|
|
|
646
|
push @result, $$rdn{value} if ($$rdn{type} eq $type); |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
33
|
|
|
|
|
140
|
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 |