[Summary view] [Print] [Text view]

   1  # Copyright (c) 1999-2004 Graham Barr <gbarr@pobox.com> and
   2  # Norbert Klasen <norbert.klasen@daasi.de> All Rights Reserved.
   3  # This program is free software; you can redistribute it and/or modify
   4  # it under the same terms as Perl itself.
   5  
   6  package Net::LDAP::Util;
   7  
   8  =head1 NAME
   9  
  10  Net::LDAP::Util - Utility functions
  11  
  12  =head1 SYNOPSIS
  13  
  14    use Net::LDAP::Util qw(ldap_error_text
  15                           ldap_error_name
  16                           ldap_error_desc
  17                          );
  18  
  19    $mesg = $ldap->search( .... );
  20  
  21    die "Error ",ldap_error_name($mesg) if $mesg->code;
  22  
  23  =head1 DESCRIPTION
  24  
  25  B<Net::LDAP::Util> is a collection of utility functions for use with
  26  the L<Net::LDAP> modules.
  27  
  28  =head1 FUNCTIONS
  29  
  30  =over 4
  31  
  32  =cut
  33  
  34  use vars qw($VERSION);
  35  require Exporter;
  36  require Net::LDAP::Constant;
  37  @ISA = qw(Exporter);
  38  @EXPORT_OK = qw(
  39    ldap_error_name
  40    ldap_error_text
  41    ldap_error_desc
  42    canonical_dn
  43    ldap_explode_dn
  44    escape_filter_value
  45    unescape_filter_value
  46    escape_dn_value
  47    unescape_dn_value
  48  );
  49  %EXPORT_TAGS = (
  50      error    => [ qw(ldap_error_name ldap_error_text ldap_error_desc) ],
  51      filter    => [ qw(escape_filter_value unescape_filter_value) ],
  52      dn        => [ qw(canonical_dn ldap_explode_dn
  53                      escape_dn_value unescape_dn_value) ],
  54      escape     => [ qw(escape_filter_value unescape_filter_value
  55                      escape_dn_value unescape_dn_value) ],
  56  );
  57  
  58  $VERSION = "0.11";
  59  
  60  =item ldap_error_name ( ERR )
  61  
  62  Returns the name corresponding with ERR. ERR can either be an LDAP
  63  error number, or a C<Net::LDAP::Message> object containing an error
  64  code. If the error is not known the a string in the form C<"LDAP error
  65  code %d(0x%02X)"> is returned.
  66  
  67  =cut
  68  
  69  # Defined in Constant.pm
  70  
  71  =item ldap_error_text ( ERR )
  72  
  73  Returns the text from the POD description for the given error. ERR can
  74  either be an LDAP error code, or a C<Net::LDAP::Message> object
  75  containing an LDAP error code. If the error code given is unknown then
  76  C<undef> is returned.
  77  
  78  =cut
  79  
  80  # Defined in Constant.pm
  81  
  82  =item ldap_error_desc ( ERR )
  83  
  84  Returns a short text description of the error. ERR can either be an
  85  LDAP error code or a C<Net::LDAP::Message> object containing an LDAP
  86  error code.
  87  
  88  =cut
  89  
  90  my @err2desc = (
  91    "Success",                                             # 0x00 LDAP_SUCCESS
  92    "Operations error",                                    # 0x01 LDAP_OPERATIONS_ERROR
  93    "Protocol error",                                      # 0x02 LDAP_PROTOCOL_ERROR
  94    "Timelimit exceeded",                                  # 0x03 LDAP_TIMELIMIT_EXCEEDED
  95    "Sizelimit exceeded",                                  # 0x04 LDAP_SIZELIMIT_EXCEEDED
  96    "Compare false",                                       # 0x05 LDAP_COMPARE_FALSE
  97    "Compare true",                                        # 0x06 LDAP_COMPARE_TRUE
  98    "Strong authentication not supported",                 # 0x07 LDAP_STRONG_AUTH_NOT_SUPPORTED
  99    "Strong authentication required",                      # 0x08 LDAP_STRONG_AUTH_REQUIRED
 100    "Partial results and referral received",               # 0x09 LDAP_PARTIAL_RESULTS
 101    "Referral received",                                   # 0x0a LDAP_REFERRAL
 102    "Admin limit exceeded",                                # 0x0b LDAP_ADMIN_LIMIT_EXCEEDED
 103    "Critical extension not available",                    # 0x0c LDAP_UNAVAILABLE_CRITICAL_EXT
 104    "Confidentiality required",                            # 0x0d LDAP_CONFIDENTIALITY_REQUIRED
 105    "SASL bind in progress",                               # 0x0e LDAP_SASL_BIND_IN_PROGRESS
 106    undef,
 107    "No such attribute",                                   # 0x10 LDAP_NO_SUCH_ATTRIBUTE
 108    "Undefined attribute type",                            # 0x11 LDAP_UNDEFINED_TYPE
 109    "Inappropriate matching",                              # 0x12 LDAP_INAPPROPRIATE_MATCHING
 110    "Constraint violation",                                # 0x13 LDAP_CONSTRAINT_VIOLATION
 111    "Type or value exists",                                # 0x14 LDAP_TYPE_OR_VALUE_EXISTS
 112    "Invalid syntax",                                      # 0x15 LDAP_INVALID_SYNTAX
 113    undef,
 114    undef,
 115    undef,
 116    undef,
 117    undef,
 118    undef,
 119    undef,
 120    undef,
 121    undef,
 122    undef,
 123    "No such object",                                      # 0x20 LDAP_NO_SUCH_OBJECT
 124    "Alias problem",                                       # 0x21 LDAP_ALIAS_PROBLEM
 125    "Invalid DN syntax",                                   # 0x22 LDAP_INVALID_DN_SYNTAX
 126    "Object is a leaf",                                    # 0x23 LDAP_IS_LEAF
 127    "Alias dereferencing problem",                         # 0x24 LDAP_ALIAS_DEREF_PROBLEM
 128    undef,
 129    undef,
 130    undef,
 131    undef,
 132    undef,
 133    undef,
 134    undef,
 135    undef,
 136    undef,
 137    undef,
 138    undef,
 139    "Inappropriate authentication",                        # 0x30 LDAP_INAPPROPRIATE_AUTH
 140    "Invalid credentials",                                 # 0x31 LDAP_INVALID_CREDENTIALS
 141    "Insufficient access",                                 # 0x32 LDAP_INSUFFICIENT_ACCESS
 142    "DSA is busy",                                         # 0x33 LDAP_BUSY
 143    "DSA is unavailable",                                  # 0x34 LDAP_UNAVAILABLE
 144    "DSA is unwilling to perform",                         # 0x35 LDAP_UNWILLING_TO_PERFORM
 145    "Loop detected",                                       # 0x36 LDAP_LOOP_DETECT
 146    undef,
 147    undef,
 148    undef,
 149    undef,
 150    undef,
 151    "Sort control missing",                                # 0x3C LDAP_SORT_CONTROL_MISSING
 152    "Index range error",                                   # 0x3D LDAP_INDEX_RANGE_ERROR
 153    undef,
 154    undef,
 155    "Naming violation",                                    # 0x40 LDAP_NAMING_VIOLATION
 156    "Object class violation",                              # 0x41 LDAP_OBJECT_CLASS_VIOLATION
 157    "Operation not allowed on nonleaf",                    # 0x42 LDAP_NOT_ALLOWED_ON_NONLEAF
 158    "Operation not allowed on RDN",                        # 0x43 LDAP_NOT_ALLOWED_ON_RDN
 159    "Already exists",                                      # 0x44 LDAP_ALREADY_EXISTS
 160    "Cannot modify object class",                          # 0x45 LDAP_NO_OBJECT_CLASS_MODS
 161    "Results too large",                                   # 0x46 LDAP_RESULTS_TOO_LARGE
 162    "Affects multiple servers",                            # 0x47 LDAP_AFFECTS_MULTIPLE_DSAS
 163    undef,
 164    undef,
 165    undef,
 166    undef,
 167    undef,
 168    undef,
 169    undef,
 170    undef,
 171    "Unknown error",                                       # 0x50 LDAP_OTHER
 172    "Can't contact LDAP server",                           # 0x51 LDAP_SERVER_DOWN
 173    "Local error",                                         # 0x52 LDAP_LOCAL_ERROR
 174    "Encoding error",                                      # 0x53 LDAP_ENCODING_ERROR
 175    "Decoding error",                                      # 0x54 LDAP_DECODING_ERROR
 176    "Timed out",                                           # 0x55 LDAP_TIMEOUT
 177    "Unknown authentication method",                       # 0x56 LDAP_AUTH_UNKNOWN
 178    "Bad search filter",                                   # 0x57 LDAP_FILTER_ERROR
 179    "Canceled",                                            # 0x58 LDAP_USER_CANCELED
 180    "Bad parameter to an ldap routine",                    # 0x59 LDAP_PARAM_ERROR
 181    "Out of memory",                                       # 0x5a LDAP_NO_MEMORY
 182    "Can't connect to the LDAP server",                    # 0x5b LDAP_CONNECT_ERROR
 183    "Not supported by this version of the LDAP protocol",  # 0x5c LDAP_NOT_SUPPORTED
 184    "Requested LDAP control not found",                    # 0x5d LDAP_CONTROL_NOT_FOUND
 185    "No results returned",                                 # 0x5e LDAP_NO_RESULTS_RETURNED
 186    "More results to return",                              # 0x5f LDAP_MORE_RESULTS_TO_RETURN
 187    "Client detected loop",                                # 0x60 LDAP_CLIENT_LOOP
 188    "Referral hop limit exceeded",                         # 0x61 LDAP_REFERRAL_LIMIT_EXCEEDED
 189  );
 190  
 191  sub ldap_error_desc {
 192    my $code = (ref($_[0]) ? $_[0]->code : $_[0]);
 193    $err2desc[$code] || sprintf("LDAP error code %d(0x%02X)",$code,$code);
 194  }
 195  
 196  
 197  
 198  
 199  
 200  =item canonical_dn ( DN [ , OPTIONS ] )
 201  
 202  Returns the given B<DN> in a canonical form. Returns undef if B<DN> is
 203  not a valid Distinguished Name. (Note: The empty string "" is a valid DN.)
 204  B<DN> can either be a string or reference to an array of hashes as returned by 
 205  ldap_explode_dn, which is useful when constructing a DN.
 206  
 207  It performs the following operations on the given B<DN>:
 208  
 209  =over 4
 210  
 211  =item *
 212  
 213  Removes the leading 'OID.' characters if the type is an OID instead
 214  of a name.
 215  
 216  =item *
 217  
 218  Escapes all RFC 2253 special characters (",", "+", """, "\", "E<lt>",
 219  "E<gt>", ";", "#", "=", " "), slashes ("/"), and any other character
 220  where the ASCII code is E<lt> 32 as \hexpair.
 221  
 222  =item *
 223  
 224  Converts all leading and trailing spaces in values to be \20.
 225  
 226  =item *
 227  
 228  If an RDN contains multiple parts, the parts are re-ordered so that
 229  the attribute type names are in alphabetical order.
 230  
 231  =back
 232  
 233  B<OPTIONS> is a list of name/value pairs, valid options are:
 234  
 235  =over 4
 236  
 237  =item casefold
 238  
 239  Controls case folding of attribute type names. Attribute values are not
 240  affected by this option. The default is to uppercase. Valid values are:
 241  
 242  =over 4
 243  
 244  =item lower
 245  
 246  Lowercase attribute type names.
 247  
 248  =item upper
 249  
 250  Uppercase attribute type names. This is the default.
 251  
 252  =item none
 253  
 254  Do not change attribute type names.
 255  
 256  =back
 257  
 258  =item mbcescape
 259  
 260  If TRUE, characters that are encoded as a multi-octet UTF-8 sequence 
 261  will be escaped as \(hexpair){2,*}.
 262  
 263  =item reverse
 264  
 265  If TRUE, the RDN sequence is reversed.
 266  
 267  =item separator
 268  
 269  Separator to use between RDNs. Defaults to comma (',').
 270  
 271  =back
 272  
 273  =cut
 274  
 275  sub canonical_dn($%) {
 276    my ($dn, %opt) = @_;
 277  
 278    return $dn unless defined $dn and $dn ne '';
 279    
 280    # create array of hash representation
 281    my $rdns = ref($dn) eq 'ARRAY'
 282          ? $dn
 283          : ldap_explode_dn( $dn, casefold => $opt{casefold} || 'upper')
 284      or return undef; #error condition
 285    
 286    # assign specified or default separator value
 287    my $separator = $opt{separator} || ',';
 288  
 289    # flatten all RDNs into strings
 290    my @flatrdns =
 291      map {
 292        my $rdn = $_;
 293        my @types = sort keys %$rdn;
 294        join('+',
 295          map {
 296            my $val = $rdn->{$_};
 297            
 298            if ( ref($val) ) {
 299              $val = '#' . unpack("H*", $$val);
 300            } else {
 301              #escape insecure characters and optionally MBCs
 302              if ( $opt{mbcescape} ) {
 303                $val =~ s/([\x00-\x1f\/\\",=+<>#;\x7f-\xff])/
 304                  sprintf("\\%02x",ord($1))/xeg;
 305              } else {
 306                $val =~ s/([\x00-\x1f\/\\",=+<>#;])/
 307                  sprintf("\\%02x",ord($1))/xeg;
 308              }
 309              #escape leading and trailing whitespace
 310              $val =~ s/(^\s+|\s+$)/
 311                "\\20" x length $1/xeg; 
 312            }
 313            
 314            # case fold attribute type and create return value
 315            if ( !$opt{casefold} || $opt{casefold} eq 'upper' ) {
 316              (uc $_)."=$val";
 317            } elsif ( $opt{casefold} eq 'lower' ) {
 318              (lc $_)."=$val";
 319            } else {
 320              "$_=$val";
 321            }
 322          } @types);
 323      } @$rdns;
 324    
 325    # join RDNs into string, optionally reversing order
 326    $opt{reverse}
 327      ? join($separator, reverse @flatrdns)
 328      : join($separator, @flatrdns);
 329  }
 330  
 331  
 332  =item ldap_explode_dn ( DN [ , OPTIONS ] )
 333  
 334  Explodes the given B<DN> into an array of hashes and returns a reference to this 
 335  array. Returns undef if B<DN> is not a valid Distinguished Name.
 336  
 337  A Distinguished Name is a sequence of Relative Distinguished Names (RDNs), which 
 338  themselves are sets of Attributes. For each RDN a hash is constructed with the 
 339  attribute type names as keys and the attribute values as corresponding values. 
 340  These hashes are then stored in an array in the order in which they appear 
 341  in the DN.
 342  
 343  For example, the DN 'OU=Sales+CN=J. Smith,DC=example,DC=net' is exploded to:
 344   [
 345     {
 346       'OU' =E<gt> 'Sales',
 347       'CN' =E<gt> 'J. Smith'
 348     },
 349     {
 350       'DC' =E<gt> 'example'
 351     },
 352     {
 353       'DC' =E<gt> 'net'
 354     }
 355   ]
 356  
 357  (RFC2253 string) DNs might also contain values, which are the bytes of the 
 358  BER encoding of the X.500 AttributeValue rather than some LDAP string syntax. 
 359  These values are hex-encoded and prefixed with a #. To distinguish such BER 
 360  values, ldap_explode_dn uses references to the actual values, 
 361  e.g. '1.3.6.1.4.1.1466.0=#04024869,DC=example,DC=com' is exploded to:
 362   [
 363     {
 364       '1.3.6.1.4.1.1466.0' =E<gt> "\004\002Hi"
 365     },
 366     {
 367       'DC' =E<gt> 'example'
 368     },
 369     {
 370       'DC' =E<gt> 'com'
 371     }
 372   ];
 373  
 374  It also performs the following operations on the given DN:
 375  
 376  =over 4
 377  
 378  =item *
 379  
 380  Unescape "\" followed by ",", "+", """, "\", "E<lt>", "E<gt>", ";",
 381  "#", "=", " ", or a hexpair and and strings beginning with "#".
 382  
 383  =item *
 384  
 385  Removes the leading 'OID.' characters if the type is an OID instead
 386  of a name.
 387  
 388  =back
 389  
 390  B<OPTIONS> is a list of name/value pairs, valid options are:
 391  
 392  =over 4
 393  
 394  =item casefold
 395  
 396  Controls case folding of attribute types names. Attribute values are not
 397  affected by this option. The default is to uppercase. Valid values are:
 398  
 399  =over 4
 400  
 401  =item lower
 402  
 403  Lowercase attribute types names.
 404  
 405  =item upper
 406  
 407  Uppercase attribute type names. This is the default.
 408  
 409  =item none
 410  
 411  Do not change attribute type names.
 412  
 413  =back
 414  
 415  =item reverse
 416  
 417  If TRUE, the RDN sequence is reversed.
 418  
 419  =back
 420  
 421  =cut
 422  
 423  sub ldap_explode_dn($%) {
 424    my ($dn, %opt) = @_;
 425    return undef unless defined $dn;
 426    return [] if $dn eq '';
 427  
 428    my (@dn, %rdn);
 429    while (
 430    $dn =~ /\G(?:
 431      \s*
 432      ([a-zA-Z][-a-zA-Z0-9]*|(?:[Oo][Ii][Dd]\.)?\d+(?:\.\d+)*)
 433      \s*
 434      =
 435      \s*
 436      (
 437        (?:[^\\",=+<>\#;]*[^\\",=+<>\#;\s]|\s*\\(?:[\\ ",=+<>#;]|[0-9a-fA-F]{2}))* 
 438        |
 439        \#(?:[0-9a-fA-F]{2})+
 440        |
 441        "(?:[^\\"]+|\\(?:[\\",=+<>#;]|[0-9a-fA-F]{2}))*"
 442      )
 443      \s*
 444      (?:([;,+])\s*(?=\S)|$)
 445      )\s*/gcx)
 446    {
 447      my($type,$val,$sep) = ($1,$2,$3);
 448  
 449      $type =~ s/^oid\.(\d+(\.\d+)*)$/$1/i; #remove leading "oid."
 450  
 451      if ( !$opt{casefold} || $opt{casefold} eq 'upper' ) {
 452        $type = uc $type;
 453      } elsif ( $opt{casefold} eq 'lower' ) {
 454        $type = lc($type);
 455      }
 456  
 457      if ( $val =~ s/^#// ) {
 458        # decode hex-encoded BER value
 459        my $tmp = pack('H*', $val);
 460        $val = \$tmp;
 461      } else {
 462        # remove quotes
 463        $val =~ s/^"(.*)"$/$1/;
 464        # unescape characters
 465        $val =~ s/\\([\\ ",=+<>#;]|[0-9a-fA-F]{2}) 
 466             /length($1)==1 ? $1 : chr(hex($1))
 467             /xeg; 
 468      }
 469  
 470      $rdn{$type} = $val;
 471  
 472      unless (defined $sep and $sep eq '+') {
 473        if ( $opt{reverse} ) {
 474          unshift @dn, { %rdn };
 475        } else {
 476          push @dn, { %rdn };
 477        }
 478        %rdn = ();
 479      }
 480    }
 481  
 482    length($dn) == (pos($dn)||0)
 483      ? \@dn
 484      : undef;
 485  }
 486  
 487  
 488  =item escape_filter_value ( VALUES )
 489  
 490  Escapes the given B<VALUES> according to RFC 2254 so that they
 491  can be safely used in LDAP filters.
 492  
 493  Any control characters with an ACII code E<lt> 32 as well as the
 494  characters with special meaning in LDAP filters "*", "(", ")",
 495  and "\" the backslash are converted into the representation
 496  of a backslash followed by two hex digits representing the
 497  hexadecimal value of the character.
 498  
 499  Returns the converted list in list mode and the first element
 500  in scalar mode.
 501  
 502  =cut
 503  
 504  ## convert a list of values into its LDAP filter encoding ##
 505  # Synopsis:  @escaped = escape_filter_value(@values)
 506  sub escape_filter_value(@)
 507  {
 508  my @values = @_;
 509  
 510    map { $_ =~ s/([\x00-\x1F\*\(\)\\])/"\\".unpack("H2",$1)/oge; } @values;
 511  
 512    return(wantarray ? @values : $values[0]);
 513  }
 514  
 515  
 516  =item unescape_filter_value ( VALUES )
 517  
 518  Undoes the conversion done by B<escape_filter_value()>.
 519  
 520  Converts any sequences of a backslash followed by two hex digits
 521  into the corresponding character.
 522  
 523  Returns the converted list in list mode and the first element
 524  in scalar mode.
 525  
 526  =cut
 527  
 528  ## convert a list of values from its LDAP filter encoding ##
 529  # Synopsis:  @values = unescape_filter_value(@escaped)
 530  sub unescape_filter_value(@)
 531  {
 532  my @values = @_;
 533  
 534    map { $_ =~ s/\\([0-9a-fA-F]{2})/pack("H2",$1)/oge; } @values;
 535  
 536    return(wantarray ? @values : $values[0]);
 537  }
 538  
 539  
 540  =item escape_dn_value ( VALUES )
 541  
 542  Escapes the given B<VALUES> according to RFC 2253 so that they
 543  can be safely used in LDAP DNs.
 544  
 545  The characters ",", "+", """, "\", "E<lt>", "E<gt>", ";", "#", "="
 546  with a special meaning in RFC 2252 are preceeded by ba backslash.
 547  Control characters with an ASCII code E<lt> 32 are represented
 548  as \hexpair.
 549  Finally all leading and trailing spaces are converted to
 550  sequences of \20.
 551  
 552  Returns the converted list in list mode and the first element
 553  in scalar mode.
 554  
 555  =cut
 556  
 557  ## convert a list of values into its DN encoding ##
 558  # Synopsis:  @escaped = escape_dn_value(@values)
 559  sub escape_dn_value(@)
 560  {
 561  my @values = @_;
 562  
 563    map { $_ =~ s/([\\",=+<>#;])/\\$1/og;
 564          $_ =~ s/([\x00-\x1F])/"\\".unpack("H2",$1)/oge;
 565          $_ =~ s/(^\s+|\s+$)/"\\20" x length($1)/oge; } @values;
 566  
 567    return(wantarray ? @values : $values[0]);
 568  }
 569  
 570  
 571  =item unescape_dn_value ( VALUES )
 572  
 573  Undoes the conversion done by B<escape_dn_value()>.
 574  
 575  Any escape sequence starting with a baskslash - hexpair or
 576  special character - will be transformed back to the
 577  corresponding character.
 578  
 579  Returns the converted list in list mode and the first element
 580  in scalar mode.
 581  
 582  =cut
 583  
 584  ## convert a list of values from its LDAP filter encoding ##
 585  # Synopsis:  @values = unescape_dn_value(@escaped)
 586  sub unescape_dn_value(@)
 587  {
 588  my @values = @_;
 589  
 590    map { $_ =~ s/\\([\\",=+<>#;]|[0-9a-fA-F]{2})
 591                 /(length($1)==1) ? $1 : pack("H2",$1)
 592                 /ogex; } @values;
 593  
 594    return(wantarray ? @values : $values[0]);
 595  }
 596  
 597  
 598  =back
 599  
 600  
 601  =head1 AUTHOR
 602  
 603  Graham Barr E<lt>gbarr@pobox.comE<gt>
 604  
 605  =head1 COPYRIGHT
 606  
 607  Copyright (c) 1999-2004 Graham Barr. All rights reserved. This program is
 608  free software; you can redistribute it and/or modify it under the same
 609  terms as Perl itself.
 610  
 611  ldap_explode_dn and canonical_dn also
 612  
 613  (c) 2002 Norbert Klasen, norbert.klasen@daasi.de, All Rights Reserved.
 614  
 615  =cut
 616  
 617  1;