line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
########################################################################### |
2
|
|
|
|
|
|
|
### Trinket::Directory::FilterParser::LDAP |
3
|
|
|
|
|
|
|
### |
4
|
|
|
|
|
|
|
### Foo |
5
|
|
|
|
|
|
|
### |
6
|
|
|
|
|
|
|
### $Id: LDAP.pm,v 1.1.1.1 2001/02/15 18:47:50 deus_x Exp $ |
7
|
|
|
|
|
|
|
### |
8
|
|
|
|
|
|
|
### TODO: |
9
|
|
|
|
|
|
|
### |
10
|
|
|
|
|
|
|
########################################################################### |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Trinket::Directory::FilterParser::LDAP; |
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
995
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
111
|
|
15
|
2
|
|
|
2
|
|
13
|
use vars qw($VERSION @ISA @EXPORT $DESCRIPTION $AUTOLOAD); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
173
|
|
16
|
2
|
|
|
2
|
|
12
|
no warnings qw( uninitialized ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
101
|
|
17
|
2
|
|
|
2
|
|
11
|
use Carp qw( confess ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
192
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# {{{ Begin POD |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 NAME |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Trinket::Directory::FilterParser::LDAP - Handle RFC1960 search filters |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 ABSTRACT |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Accept an LDAP-like search filter to find objects. |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 SYNOPSIS |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my @objs = $serializer->Search |
32
|
|
|
|
|
|
|
('(&(parent=1)(objectclass=Iaido::Object::Folder))'); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
my @objs = $serializer->Search |
35
|
|
|
|
|
|
|
(qq^ |
36
|
|
|
|
|
|
|
(& |
37
|
|
|
|
|
|
|
(path~=/hivemind/*) |
38
|
|
|
|
|
|
|
(objectclass=Iaido::Object::Hivemind::Task) |
39
|
|
|
|
|
|
|
(| (parent=2378)(parent=2124)(parent=2308)(parent=3217) ) |
40
|
|
|
|
|
|
|
(| (author=1949)(author=4158) ) |
41
|
|
|
|
|
|
|
(& (created>=883976400)(created<=947307600) ) |
42
|
|
|
|
|
|
|
(closed=0) |
43
|
|
|
|
|
|
|
) |
44
|
|
|
|
|
|
|
^); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 DESCRIPTION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
The parse_filter() method accepts a filter string, based on and |
49
|
|
|
|
|
|
|
mostly compatible with RFC1960 (http://www.ietf.org/rfc/rfc1960.txt), |
50
|
|
|
|
|
|
|
the string representation format of Lightweight Directory Access Protocol |
51
|
|
|
|
|
|
|
(LDAP) search filters. (TODO: Detail what features, if any, of the spec |
52
|
|
|
|
|
|
|
are not supported) |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# }}} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# {{{ METADATA |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
BEGIN |
61
|
|
|
|
|
|
|
{ |
62
|
2
|
|
|
2
|
|
5
|
$VERSION = "0.0"; |
63
|
2
|
|
|
|
|
37
|
@ISA = qw( Trinket::Directory::FilterParser ); |
64
|
2
|
|
|
|
|
39
|
$DESCRIPTION = 'LDAP (RFC1960) search filter parser'; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# }}} |
68
|
|
|
|
|
|
|
|
69
|
2
|
|
|
2
|
|
578
|
use Trinket::Directory::FilterParser; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
269
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# {{{ EXPORTS |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 EXPORTS |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
TODO |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=cut |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# }}} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# {{{ METHODS |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 METHODS |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=over 4 |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# }}} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# {{{ init(): Object initializer |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub init { |
94
|
2
|
|
|
2
|
|
11
|
no strict 'refs'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
1434
|
|
95
|
7
|
|
|
7
|
0
|
24
|
my ($self, $props) = @_; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# }}} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
### To give credit where credit is due: LDAP search filter processing was |
101
|
|
|
|
|
|
|
### borrowed via cut and paste from Graham Barr's Net::LDAP::Filter module |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
### Regular expressions to recognize LDAP attributes, operators, and |
104
|
|
|
|
|
|
|
### search values |
105
|
|
|
|
|
|
|
my($Attr) = qw{ [-;.:\d\w]*[-;\d\w] }; |
106
|
|
|
|
|
|
|
my($Op) = qw{ ~=|<=|>=|<|>|= }; |
107
|
|
|
|
|
|
|
my($Value) = qw{ (?:\\.|[^\\()]+)* }; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
### Define a mapping between LDAP filter operators to search filter |
110
|
|
|
|
|
|
|
### LoL node names |
111
|
|
|
|
|
|
|
# my %Op = |
112
|
|
|
|
|
|
|
# qw( |
113
|
|
|
|
|
|
|
# & FILTER_AND |
114
|
|
|
|
|
|
|
# | FILTER_OR |
115
|
|
|
|
|
|
|
# ! FILTER_NOT |
116
|
|
|
|
|
|
|
# = FILTER_EQ |
117
|
|
|
|
|
|
|
# ~= FILTER_APPROX |
118
|
|
|
|
|
|
|
# > FILTER_GT |
119
|
|
|
|
|
|
|
# >= FILTER_GE |
120
|
|
|
|
|
|
|
# < FILTER_LT |
121
|
|
|
|
|
|
|
# <= FILTER_LE |
122
|
|
|
|
|
|
|
# ); |
123
|
|
|
|
|
|
|
my %Op = |
124
|
|
|
|
|
|
|
qw( |
125
|
|
|
|
|
|
|
& AND |
126
|
|
|
|
|
|
|
| OR |
127
|
|
|
|
|
|
|
! NOT |
128
|
|
|
|
|
|
|
= EQ |
129
|
|
|
|
|
|
|
~= APPROX |
130
|
|
|
|
|
|
|
> GT |
131
|
|
|
|
|
|
|
>= GE |
132
|
|
|
|
|
|
|
< LT |
133
|
|
|
|
|
|
|
<= LE |
134
|
|
|
|
|
|
|
); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
### Reverse the LDAP op to node name mapping. |
137
|
|
|
|
|
|
|
my %Rop = reverse %Op; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
### Define a mapping of search filter LoL node names to compilation methods |
140
|
|
|
|
|
|
|
my %node_methods = |
141
|
|
|
|
|
|
|
( |
142
|
|
|
|
|
|
|
'FILTER_AND' => 'sql_and_seq', |
143
|
|
|
|
|
|
|
'FILTER_OR' => 'sql_or_seq', |
144
|
|
|
|
|
|
|
'FILTER_NOT' => 'sql_not_seq', |
145
|
|
|
|
|
|
|
'FILTER_EQ' => 'sql_leaf', |
146
|
|
|
|
|
|
|
'FILTER_APPROX' => 'sql_leaf', |
147
|
|
|
|
|
|
|
'FILTER_GT' => 'sql_leaf', |
148
|
|
|
|
|
|
|
'FILTER_GE' => 'sql_leaf', |
149
|
|
|
|
|
|
|
'FILTER_LT' => 'sql_leaf', |
150
|
|
|
|
|
|
|
'FILTER_LE' => 'sql_leaf', |
151
|
|
|
|
|
|
|
); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
### Define a mapping of search filter LoL leaf node names to SQL operators. |
154
|
|
|
|
|
|
|
my %leaf_sql_ops = |
155
|
|
|
|
|
|
|
( |
156
|
|
|
|
|
|
|
'FILTER_EQ' => '=', |
157
|
|
|
|
|
|
|
'FILTER_APPROX' => ' LIKE ', |
158
|
|
|
|
|
|
|
'FILTER_GT' => '>', |
159
|
|
|
|
|
|
|
'FILTER_GE' => '>=', |
160
|
|
|
|
|
|
|
'FILTER_LT' => '<', |
161
|
|
|
|
|
|
|
'FILTER_LE' => '<=', |
162
|
|
|
|
|
|
|
); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# {{{ parse: Parse a search filter into an LoL |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub parse { |
167
|
15
|
|
|
15
|
0
|
108
|
my ($self, $filter) = @_; |
168
|
|
|
|
|
|
|
|
169
|
15
|
|
|
|
|
29
|
my @stack = (); # stack |
170
|
15
|
|
|
|
|
34
|
my $cur = []; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Algorithm depends on /^\(/; |
173
|
15
|
|
|
|
|
83
|
$filter =~ s/^\s*//; |
174
|
15
|
100
|
|
|
|
70
|
$filter = "(" . $filter . ")" unless $filter =~ /^\(/; |
175
|
|
|
|
|
|
|
|
176
|
15
|
|
|
|
|
49
|
while (length($filter)) { |
177
|
|
|
|
|
|
|
# Process the start of (& (...)(...)) |
178
|
42
|
100
|
|
|
|
145
|
if ($filter =~ s/^\(\s*([&|!])\s*//) { |
179
|
9
|
|
|
|
|
19
|
my $n = []; # new list to hold filter elements |
180
|
9
|
|
|
|
|
30
|
push(@$cur, $Op{$1}, $n); |
181
|
9
|
|
|
|
|
16
|
push(@stack,$cur); # push current list on the stack |
182
|
9
|
|
|
|
|
15
|
$cur = $n; |
183
|
9
|
|
|
|
|
25
|
next; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Process the end of (& (...)(...)) |
187
|
33
|
100
|
|
|
|
94
|
if ($filter =~ s/^\)\s*//o) { |
188
|
9
|
|
|
|
|
16
|
$cur = pop @stack; |
189
|
9
|
100
|
|
|
|
29
|
last unless @stack; |
190
|
4
|
|
|
|
|
10
|
next; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
# present is a special case (attr=*) |
194
|
|
|
|
|
|
|
#if ($filter =~ s/^\(\s*($Attr)=\*\)\s*//o) |
195
|
|
|
|
|
|
|
# { push(@$cur, FILTER_PRESENT => $1); next; } |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# process (attr op string) |
198
|
24
|
50
|
|
|
|
334
|
if ($filter =~ s/^\(\s*($Attr)\s*($Op)($Value)\)\s*//o) |
199
|
24
|
|
|
|
|
62
|
{ push(@$cur, encode($1,$2,$3)); next; } |
|
24
|
|
|
|
|
150
|
|
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# If we get here then there is an error in the filter string |
202
|
|
|
|
|
|
|
# so exit loop with data in $filter |
203
|
0
|
|
|
|
|
0
|
last; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
15
|
50
|
|
|
|
42
|
if (length $filter) { |
207
|
|
|
|
|
|
|
# If we have anything left in the filter, then there is a problem |
208
|
0
|
|
|
|
|
0
|
confess("Bad filter, error before " . substr($filter,0,20)); |
209
|
0
|
|
|
|
|
0
|
return undef; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
15
|
|
|
|
|
47
|
return $cur; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# }}} |
216
|
|
|
|
|
|
|
# {{{ encode: Encode a leaf filter node into the LoL |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub encode { |
219
|
24
|
|
|
24
|
0
|
75
|
my($attr,$op,$val) = @_; |
220
|
24
|
|
|
|
|
66
|
return ($Op{$op} => [ STRING => $attr, STRING => unescape($val) ]); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# }}} |
224
|
|
|
|
|
|
|
# {{{ escape: Escape 'illegal' characters in the filter |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub escape { |
227
|
0
|
|
|
0
|
0
|
0
|
$_[0] =~ s/([\\\(\)\*\0])/sprintf("\\%02x",ord($1))/sge; |
|
0
|
|
|
|
|
0
|
|
228
|
0
|
|
|
|
|
0
|
$_[0]; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# }}} |
232
|
|
|
|
|
|
|
# {{{ unescape: Unescape 'illegal' characters in the filter |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub unescape { |
235
|
24
|
0
|
|
24
|
0
|
60
|
$_[0] =~ s/\\([\da-fA-F]{2}|.)/length($1) == 1 ? $1 : chr(hex($1))/soxeg; |
|
0
|
|
|
|
|
0
|
|
236
|
24
|
|
|
|
|
109
|
$_[0]; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# }}} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# {{{ DESTROY |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub DESTROY |
244
|
0
|
|
|
0
|
|
|
{ |
245
|
|
|
|
|
|
|
## no-op to pacify warnings |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# }}} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# {{{ End POD |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=back |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 AUTHOR |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Maintained by Leslie Michael Orchard > |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head1 COPYRIGHT |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
Copyright (c) 2000, Leslie Michael Orchard. All Rights Reserved. |
261
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
262
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=cut |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# }}} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
1; |
269
|
|
|
|
|
|
|
__END__ |