[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 # Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved. 2 # This program is free software; you can redistribute it and/or 3 # modify it under the same terms as Perl itself. 4 5 package Net::LDAP::Filter; 6 7 use strict; 8 use vars qw($VERSION); 9 10 $VERSION = "0.15"; 11 12 # filter = "(" filtercomp ")" 13 # filtercomp = and / or / not / item 14 # and = "&" filterlist 15 # or = "|" filterlist 16 # not = "!" filter 17 # filterlist = 1*filter 18 # item = simple / present / substring / extensible 19 # simple = attr filtertype value 20 # filtertype = equal / approx / greater / less 21 # equal = "=" 22 # approx = "~=" 23 # greater = ">=" 24 # less = "<=" 25 # extensible = attr [":dn"] [":" matchingrule] ":=" value 26 # / [":dn"] ":" matchingrule ":=" value 27 # present = attr "=*" 28 # substring = attr "=" [initial] any [final] 29 # initial = value 30 # any = "*" *(value "*") 31 # final = value 32 # attr = AttributeDescription from Section 4.1.5 of [1] 33 # matchingrule = MatchingRuleId from Section 4.1.9 of [1] 34 # value = AttributeValue from Section 4.1.6 of [1] 35 # 36 # Special Character encodings 37 # --------------------------- 38 # * \2a, \* 39 # ( \28, \( 40 # ) \29, \) 41 # \ \5c, \\ 42 # NUL \00 43 44 my $ErrStr; 45 46 sub new { 47 my $self = shift; 48 my $class = ref($self) || $self; 49 50 my $me = bless {}, $class; 51 52 if (@_) { 53 $me->parse(shift) or 54 return undef; 55 } 56 $me; 57 } 58 59 my $Attr = '[-;.:\d\w]*[-;\d\w]'; 60 61 my %Op = qw( 62 & and 63 | or 64 ! not 65 = equalityMatch 66 ~= approxMatch 67 >= greaterOrEqual 68 <= lessOrEqual 69 := extensibleMatch 70 ); 71 72 my %Rop = reverse %Op; 73 74 # Unescape 75 # \xx where xx is a 2-digit hex number 76 # \y where y is one of ( ) \ * 77 78 sub errstr { $ErrStr } 79 80 sub _unescape { 81 $_[0] =~ s/ 82 \\([\da-fA-F]{2}|.) 83 / 84 length($1) == 1 85 ? $1 86 : chr(hex($1)) 87 /soxeg; 88 $_[0]; 89 } 90 91 sub _escape { (my $t = $_[0]) =~ s/([\\\(\)\*\0-\37\177-\377])/sprintf("\\%02x",ord($1))/sge; $t } 92 93 sub _encode { 94 my($attr,$op,$val) = @_; 95 96 # An extensible match 97 98 if ($op eq ':=') { 99 100 # attr must be in the form type:dn:1.2.3.4 101 unless ($attr =~ /^([-;\d\w]*)(:dn)?(:(\w+|[.\d]+))?$/) { 102 $ErrStr = "Bad attribute $attr"; 103 return undef; 104 } 105 my($type,$dn,$rule) = ($1,$2,$4); 106 107 return ( { 108 extensibleMatch => { 109 matchingRule => $rule, 110 type => length($type) ? $type : undef, 111 matchValue => _unescape($val), 112 dnAttributes => $dn ? 1 : undef 113 } 114 }); 115 } 116 117 # If the op is = and contains one or more * not 118 # preceeded by \ then do partial matches 119 120 if ($op eq '=' && $val =~ /^(\\.|[^\\*]+)*\*/o ) { 121 122 my $n = []; 123 my $type = 'initial'; 124 125 while ($val =~ s/^((\\.|[^\\*]+)*)\*//) { 126 push(@$n, { $type, _unescape("$1") }) # $1 is readonly, copy it 127 if length($1) or $type eq 'any'; 128 129 $type = 'any'; 130 } 131 132 push(@$n, { 'final', _unescape($val) }) 133 if length $val; 134 135 return ({ 136 substrings => { 137 type => $attr, 138 substrings => $n 139 } 140 }); 141 } 142 143 # Well we must have an operator and no un-escaped *'s on the RHS 144 145 return { 146 $Op{$op} => { 147 attributeDesc => $attr, assertionValue => _unescape($val) 148 } 149 }; 150 } 151 152 sub parse { 153 my $self = shift; 154 my $filter = shift; 155 156 my @stack = (); # stack 157 my $cur = []; 158 my $op; 159 160 undef $ErrStr; 161 162 # a filter is required 163 if (!defined $filter) { 164 $ErrStr = "Undefined filter"; 165 return undef; 166 } 167 168 # Algorithm depends on /^\(/; 169 $filter =~ s/^\s*//; 170 171 $filter = "(" . $filter . ")" 172 unless $filter =~ /^\(/; 173 174 while (length($filter)) { 175 176 # Process the start of (& (...)(...)) 177 178 if ($filter =~ s/^\(\s*([&!|])\s*//) { 179 push @stack, [$op,$cur]; 180 $op = $1; 181 $cur = []; 182 next; 183 } 184 185 # Process the end of (& (...)(...)) 186 187 elsif ($filter =~ s/^\)\s*//o) { 188 unless (@stack) { 189 $ErrStr = "Bad filter, unmatched )"; 190 return undef; 191 } 192 my($myop,$mydata) = ($op,$cur); 193 ($op,$cur) = @{ pop @stack }; 194 # Need to do more checking here 195 push @$cur, { $Op{$myop} => $myop eq '!' ? $mydata->[0] : $mydata }; 196 next if @stack; 197 } 198 199 # present is a special case (attr=*) 200 201 elsif ($filter =~ s/^\(\s*($Attr)=\*\)\s*//o) { 202 push(@$cur, { present => $1 } ); 203 next if @stack; 204 } 205 206 # process (attr op string) 207 208 elsif ($filter =~ s/^\(\s* 209 ($Attr)\s* 210 ([:~<>]?=) 211 ((?:\\.|[^\\()]+)*) 212 \)\s* 213 //xo) { 214 push(@$cur, _encode($1,$2,$3)); 215 next if @stack; 216 } 217 218 # If we get here then there is an error in the filter string 219 # so exit loop with data in $filter 220 last; 221 } 222 223 if (length $filter) { 224 # If we have anything left in the filter, then there is a problem 225 $ErrStr = "Bad filter, error before " . substr($filter,0,20); 226 return undef; 227 } 228 if (@stack) { 229 $ErrStr = "Bad filter, unmatched ("; 230 return undef; 231 } 232 233 %$self = %{$cur->[0]}; 234 235 $self; 236 } 237 238 sub print { 239 my $self = shift; 240 no strict 'refs'; # select may return a GLOB name 241 my $fh = @_ ? shift : select; 242 243 print $fh $self->as_string,"\n"; 244 } 245 246 sub as_string { _string(%{$_[0]}) } 247 248 sub _string { # prints things of the form (<op> (<list>) ... ) 249 my $i; 250 my $str = ""; 251 252 for ($_[0]) { 253 /^and/ and return "(&" . join("", map { _string(%$_) } @{$_[1]}) . ")"; 254 /^or/ and return "(|" . join("", map { _string(%$_) } @{$_[1]}) . ")"; 255 /^not/ and return "(!" . _string(%{$_[1]}) . ")"; 256 /^present/ and return "($_[1]=*)"; 257 /^(equalityMatch|greaterOrEqual|lessOrEqual|approxMatch)/ 258 and return "(" . $_[1]->{attributeDesc} . $Rop{$1} . _escape($_[1]->{assertionValue}) .")"; 259 /^substrings/ and do { 260 my $str = join("*", "",map { _escape($_) } map { values %$_ } @{$_[1]->{substrings}}); 261 $str =~ s/^.// if exists $_[1]->{substrings}[0]{initial}; 262 $str .= '*' unless exists $_[1]->{substrings}[-1]{final}; 263 return "($_[1]->{type}=$str)"; 264 }; 265 /^extensibleMatch/ and do { 266 my $str = "("; 267 $str .= $_[1]->{type} if defined $_[1]->{type}; 268 $str .= ":dn" if $_[1]->{dnAttributes}; 269 $str .= ":$_[1]->{matchingRule}" if defined $_[1]->{matchingRule}; 270 $str .= ":=" . _escape($_[1]->{matchValue}) . ")"; 271 return $str; 272 }; 273 } 274 275 die "Internal error $_[0]"; 276 } 277 278 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |