package Net::LDAP::Util;
=head1 NAME
Net::LDAP::Util - Utility functions
=head1 SYNOPSIS
use Net::LDAP::Util qw(ldap_error_text
ldap_error_name
ldap_error_desc
);
$mesg = $ldap->search( .... );
die "Error ",ldap_error_name($mesg) if $mesg->code;
=head1 DESCRIPTION
B<Net::LDAP::Util> is a collection of utility functions for use with
the L<Net::LDAP> modules.
=head1 FUNCTIONS
=over 4
=cut
use vars qw($VERSION);
require Exporter;
require Net::LDAP::Constant;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
ldap_error_name
ldap_error_text
ldap_error_desc
canonical_dn
ldap_explode_dn
escape_filter_value
unescape_filter_value
escape_dn_value
unescape_dn_value
);
%EXPORT_TAGS = (
error => [ qw(ldap_error_name ldap_error_text ldap_error_desc) ],
filter => [ qw(escape_filter_value unescape_filter_value) ],
dn => [ qw(canonical_dn ldap_explode_dn
escape_dn_value unescape_dn_value) ],
escape => [ qw(escape_filter_value unescape_filter_value
escape_dn_value unescape_dn_value) ],
);
$VERSION = "0.11";
=item ldap_error_name ( ERR )
Returns the name corresponding with ERR. ERR can either be an LDAP
error number, or a C<Net::LDAP::Message> object containing an error
code. If the error is not known the a string in the form C<"LDAP error
code %d(0x%02X)"> is returned.
=cut
=item ldap_error_text ( ERR )
Returns the text from the POD description for the given error. ERR can
either be an LDAP error code, or a C<Net::LDAP::Message> object
containing an LDAP error code. If the error code given is unknown then
C<undef> is returned.
=cut
=item ldap_error_desc ( ERR )
Returns a short text description of the error. ERR can either be an
LDAP error code or a C<Net::LDAP::Message> object containing an LDAP
error code.
=cut
my @err2desc = (
"Success", "Operations error", "Protocol error", "Timelimit exceeded", "Sizelimit exceeded", "Compare false", "Compare true", "Strong authentication not supported", "Strong authentication required", "Partial results and referral received", "Referral received", "Admin limit exceeded", "Critical extension not available", "Confidentiality required", "SASL bind in progress", undef,
"No such attribute", "Undefined attribute type", "Inappropriate matching", "Constraint violation", "Type or value exists", "Invalid syntax", undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
"No such object", "Alias problem", "Invalid DN syntax", "Object is a leaf", "Alias dereferencing problem", undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
"Inappropriate authentication", "Invalid credentials", "Insufficient access", "DSA is busy", "DSA is unavailable", "DSA is unwilling to perform", "Loop detected", undef,
undef,
undef,
undef,
undef,
"Sort control missing", "Index range error", undef,
undef,
"Naming violation", "Object class violation", "Operation not allowed on nonleaf", "Operation not allowed on RDN", "Already exists", "Cannot modify object class", "Results too large", "Affects multiple servers", undef,
undef,
undef,
undef,
undef,
undef,
undef,
undef,
"Unknown error", "Can't contact LDAP server", "Local error", "Encoding error", "Decoding error", "Timed out", "Unknown authentication method", "Bad search filter", "Canceled", "Bad parameter to an ldap routine", "Out of memory", "Can't connect to the LDAP server", "Not supported by this version of the LDAP protocol", "Requested LDAP control not found", "No results returned", "More results to return", "Client detected loop", "Referral hop limit exceeded", );
sub ldap_error_desc {
my $code = (ref($_[0]) ? $_[0]->code : $_[0]);
$err2desc[$code] || sprintf("LDAP error code %d(0x%02X)",$code,$code);
}
=item canonical_dn ( DN [ , OPTIONS ] )
Returns the given B<DN> in a canonical form. Returns undef if B<DN> is
not a valid Distinguished Name. (Note: The empty string "" is a valid DN.)
B<DN> can either be a string or reference to an array of hashes as returned by
ldap_explode_dn, which is useful when constructing a DN.
It performs the following operations on the given B<DN>:
=over 4
=item *
Removes the leading 'OID.' characters if the type is an OID instead
of a name.
=item *
Escapes all RFC 2253 special characters (",", "+", """, "\", "E<lt>",
"E<gt>", ";", "#", "=", " "), slashes ("/"), and any other character
where the ASCII code is E<lt> 32 as \hexpair.
=item *
Converts all leading and trailing spaces in values to be \20.
=item *
If an RDN contains multiple parts, the parts are re-ordered so that
the attribute type names are in alphabetical order.
=back
B<OPTIONS> is a list of name/value pairs, valid options are:
=over 4
=item casefold
Controls case folding of attribute type names. Attribute values are not
affected by this option. The default is to uppercase. Valid values are:
=over 4
=item lower
Lowercase attribute type names.
=item upper
Uppercase attribute type names. This is the default.
=item none
Do not change attribute type names.
=back
=item mbcescape
If TRUE, characters that are encoded as a multi-octet UTF-8 sequence
will be escaped as \(hexpair){2,*}.
=item reverse
If TRUE, the RDN sequence is reversed.
=item separator
Separator to use between RDNs. Defaults to comma (',').
=back
=cut
sub canonical_dn($%) {
my ($dn, %opt) = @_;
return $dn unless defined $dn and $dn ne '';
my $rdns = ref($dn) eq 'ARRAY'
? $dn
: ldap_explode_dn( $dn, casefold => $opt{casefold} || 'upper')
or return undef;
my $separator = $opt{separator} || ',';
my @flatrdns =
map {
my $rdn = $_;
my @types = sort keys %$rdn;
join('+',
map {
my $val = $rdn->{$_};
if ( ref($val) ) {
$val = '#' . unpack("H*", $$val);
} else {
if ( $opt{mbcescape} ) {
$val =~ s/([\x00-\x1f\/\\",=+<> sprintf("\\%02x",ord($1))/xeg;
} else {
$val =~ s/([\x00-\x1f\/\\",=+<> sprintf("\\%02x",ord($1))/xeg;
}
$val =~ s/(^\s+|\s+$)/
"\\20" x length $1/xeg;
}
if ( !$opt{casefold} || $opt{casefold} eq 'upper' ) {
(uc $_)."=$val";
} elsif ( $opt{casefold} eq 'lower' ) {
(lc $_)."=$val";
} else {
"$_=$val";
}
} @types);
} @$rdns;
$opt{reverse}
? join($separator, reverse @flatrdns)
: join($separator, @flatrdns);
}
=item ldap_explode_dn ( DN [ , OPTIONS ] )
Explodes the given B<DN> into an array of hashes and returns a reference to this
array. Returns undef if B<DN> is not a valid Distinguished Name.
A Distinguished Name is a sequence of Relative Distinguished Names (RDNs), which
themselves are sets of Attributes. For each RDN a hash is constructed with the
attribute type names as keys and the attribute values as corresponding values.
These hashes are then stored in an array in the order in which they appear
in the DN.
For example, the DN 'OU=Sales+CN=J. Smith,DC=example,DC=net' is exploded to:
[
{
'OU' =E<gt> 'Sales',
'CN' =E<gt> 'J. Smith'
},
{
'DC' =E<gt> 'example'
},
{
'DC' =E<gt> 'net'
}
]
(RFC2253 string) DNs might also contain values, which are the bytes of the
BER encoding of the X.500 AttributeValue rather than some LDAP string syntax.
These values are hex-encoded and prefixed with a #. To distinguish such BER
values, ldap_explode_dn uses references to the actual values,
e.g. '1.3.6.1.4.1.1466.0=#04024869,DC=example,DC=com' is exploded to:
[
{
'1.3.6.1.4.1.1466.0' =E<gt> "\004\002Hi"
},
{
'DC' =E<gt> 'example'
},
{
'DC' =E<gt> 'com'
}
];
It also performs the following operations on the given DN:
=over 4
=item *
Unescape "\" followed by ",", "+", """, "\", "E<lt>", "E<gt>", ";",
"#", "=", " ", or a hexpair and and strings beginning with "#".
=item *
Removes the leading 'OID.' characters if the type is an OID instead
of a name.
=back
B<OPTIONS> is a list of name/value pairs, valid options are:
=over 4
=item casefold
Controls case folding of attribute types names. Attribute values are not
affected by this option. The default is to uppercase. Valid values are:
=over 4
=item lower
Lowercase attribute types names.
=item upper
Uppercase attribute type names. This is the default.
=item none
Do not change attribute type names.
=back
=item reverse
If TRUE, the RDN sequence is reversed.
=back
=cut
sub ldap_explode_dn($%) {
my ($dn, %opt) = @_;
return undef unless defined $dn;
return [] if $dn eq '';
my (@dn, %rdn);
while (
$dn =~ /\G(?:
\s*
([a-zA-Z][-a-zA-Z0-9]*|(?:[Oo][Ii][Dd]\.)?\d+(?:\.\d+)*)
\s*
=
\s*
(
(?:[^\\",=+<>\ |
\ |
"(?:[^\\"]+|\\(?:[\\",=+<> )
\s*
(?:([;,+])\s*(?=\S)|$)
)\s*/gcx)
{
my($type,$val,$sep) = ($1,$2,$3);
$type =~ s/^oid\.(\d+(\.\d+)*)$/$1/i;
if ( !$opt{casefold} || $opt{casefold} eq 'upper' ) {
$type = uc $type;
} elsif ( $opt{casefold} eq 'lower' ) {
$type = lc($type);
}
if ( $val =~ s/^ my $tmp = pack('H*', $val);
$val = \$tmp;
} else {
$val =~ s/^"(.*)"$/$1/;
$val =~ s/\\([\\ ",=+<>#;]|[0-9a-fA-F]{2})
/length($1)==1 ? $1 : chr(hex($1))
/xeg;
}
$rdn{$type} = $val;
unless (defined $sep and $sep eq '+') {
if ( $opt{reverse} ) {
unshift @dn, { %rdn };
} else {
push @dn, { %rdn };
}
%rdn = ();
}
}
length($dn) == (pos($dn)||0)
? \@dn
: undef;
}
=item escape_filter_value ( VALUES )
Escapes the given B<VALUES> according to RFC 2254 so that they
can be safely used in LDAP filters.
Any control characters with an ACII code E<lt> 32 as well as the
characters with special meaning in LDAP filters "*", "(", ")",
and "\" the backslash are converted into the representation
of a backslash followed by two hex digits representing the
hexadecimal value of the character.
Returns the converted list in list mode and the first element
in scalar mode.
=cut
sub escape_filter_value(@)
{
my @values = @_;
map { $_ =~ s/([\x00-\x1F\*\(\)\\])/"\\".unpack("H2",$1)/oge; } @values;
return(wantarray ? @values : $values[0]);
}
=item unescape_filter_value ( VALUES )
Undoes the conversion done by B<escape_filter_value()>.
Converts any sequences of a backslash followed by two hex digits
into the corresponding character.
Returns the converted list in list mode and the first element
in scalar mode.
=cut
sub unescape_filter_value(@)
{
my @values = @_;
map { $_ =~ s/\\([0-9a-fA-F]{2})/pack("H2",$1)/oge; } @values;
return(wantarray ? @values : $values[0]);
}
=item escape_dn_value ( VALUES )
Escapes the given B<VALUES> according to RFC 2253 so that they
can be safely used in LDAP DNs.
The characters ",", "+", """, "\", "E<lt>", "E<gt>", ";", "#", "="
with a special meaning in RFC 2252 are preceeded by ba backslash.
Control characters with an ASCII code E<lt> 32 are represented
as \hexpair.
Finally all leading and trailing spaces are converted to
sequences of \20.
Returns the converted list in list mode and the first element
in scalar mode.
=cut
sub escape_dn_value(@)
{
my @values = @_;
map { $_ =~ s/([\\",=+<> $_ =~ s/([\x00-\x1F])/"\\".unpack("H2",$1)/oge;
$_ =~ s/(^\s+|\s+$)/"\\20" x length($1)/oge; } @values;
return(wantarray ? @values : $values[0]);
}
=item unescape_dn_value ( VALUES )
Undoes the conversion done by B<escape_dn_value()>.
Any escape sequence starting with a baskslash - hexpair or
special character - will be transformed back to the
corresponding character.
Returns the converted list in list mode and the first element
in scalar mode.
=cut
sub unescape_dn_value(@)
{
my @values = @_;
map { $_ =~ s/\\([\\",=+<> /(length($1)==1) ? $1 : pack("H2",$1)
/ogex; } @values;
return(wantarray ? @values : $values[0]);
}
=back
=head1 AUTHOR
Graham Barr E<lt>gbarr@pobox.comE<gt>
=head1 COPYRIGHT
Copyright (c) 1999-2004 Graham Barr. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
ldap_explode_dn and canonical_dn also
(c) 2002 Norbert Klasen, norbert.klasen@daasi.de, All Rights Reserved.
=cut
1;