Bug #117524 for Catalyst-Model-LDAP: raw, authz new options. Docs, new reqs, control => [] cleanups and UTF-8 patch.

Thanks.

Index: lib/Catalyst/Model/LDAP.pm =================================================================== --- lib/Catalyst/Model/LDAP.pm (revision 14560) +++ lib/Catalyst/Model/LDAP.pm (working copy) @@ -5,7 +5,7 @@ use base qw/Catalyst::Model/; use Carp qw/croak/; -our $VERSION = '0.17'; +our $VERSION = '0.18'; =head1 NAME @@ -170,6 +170,8 @@ =item * Marcus Ramberg (paging support and entry AUTOLOAD) +=item * Gavin Henry <ghenry@surevoip.co.uk> (authz and raw support, plus bug fixes) + =back =head1 ACKNOWLEDGMENTS Index: lib/Catalyst/Model/LDAP/Connection.pm =================================================================== --- lib/Catalyst/Model/LDAP/Connection.pm (revision 14560) +++ lib/Catalyst/Model/LDAP/Connection.pm (working copy) @@ -5,11 +5,13 @@ use base qw/Net::LDAP Class::Accessor::Fast/; use Carp qw/croak/; use Catalyst::Model::LDAP::Search; +use Data::Dumper; use Data::Page; use MRO::Compat; use Net::LDAP::Constant qw/LDAP_CONTROL_VLVRESPONSE/; use Net::LDAP::Control::Sort; use Net::LDAP::Control::VLV; +use Net::LDAP::Control::ProxyAuth; __PACKAGE__->mk_accessors(qw/base options entry_class/); @@ -71,18 +73,20 @@ =cut sub new { - my ($class, %args) = @_; + my ( $class, %args ) = @_; my $base = delete $args{base}; - my %options = %{ ref $args{options} eq 'HASH' ? delete $args{options} : {} }; - my $entry_class = delete $args{entry_class} || 'Catalyst::Model::LDAP::Entry'; + my %options = + %{ ref $args{options} eq 'HASH' ? delete $args{options} : {} }; + my $entry_class = delete $args{entry_class} + || 'Catalyst::Model::LDAP::Entry'; my $host = delete $args{host}; - my $self = $class->next::method($host, %args); + my $self = $class->next::method( $host, %args ); croak "Error connecting to $host: $@" unless $self; $self->base($base); - $self->options(\%options); + $self->options( \%options ); $self->entry_class($entry_class); return $self; @@ -116,22 +120,21 @@ =cut sub bind { - my ($self, %args) = @_; + my ( $self, %args ) = @_; delete $args{$_} for qw/host base options connection_class entry_class/; # Bind using TLS if configured - if (delete $args{start_tls}) { - my $mesg = $self->start_tls( - %{ delete $args{start_tls_options} || {} }, - ); + if ( delete $args{start_tls} ) { + my $mesg = + $self->start_tls( %{ delete $args{start_tls_options} || {} }, ); croak 'LDAP TLS error: ' . $mesg->error if $mesg->is_error; } # Bind via DN if configured my $dn = delete $args{dn}; - $self->next::method($dn ? ($dn, %args) : %args); + $self->next::method( $dn ? ( $dn, %args ) : %args ); } =head2 search @@ -147,6 +150,30 @@ =over 4 +=item C<raw> + +Use REGEX to denote the names of attributes that are to be considered binary +in search results. + +When this option is given, Net::LDAP converts all values of attributes B<not> +matching this REGEX into Perl UTF-8 strings so that the regular Perl operators +(pattern matching, ...) can operate as one expects even on strings with +international characters. + +If this option is not given, attribute values are treated as byte strings. + +Generally, you'll only ever need to do this if using RFC'd LDAP attributes +and not a custom LDAP schema: + + raw => qr/(?i:^jpegPhoto|;binary)/, + +=item C<authz> + +This allows you to use LDAPv3 Proxy Authorization control object, i.e. +(L<Net::LDAP::Control::ProxyAuth>): + + authz => 'uid=gavinhenry,ou=users,dc=surevoip,dc=co,dc=uk', + =item C<page> Which page to return. @@ -169,10 +196,10 @@ sub search { my $self = shift; - my %args = scalar @_ == 1 ? (filter => shift) : @_; + my %args = scalar @_ == 1 ? ( filter => shift ) : @_; croak "Cannot use 'page' without 'order_by'" - if $args{page} and not $args{order_by}; + if $args{page} and not $args{order_by}; # Use default base %args = ( @@ -181,40 +208,48 @@ %args, ); + # Allow ProxyAuth by itself + if ( my $authz = delete $args{authz} ) { + my $authz = + Net::LDAP::Control::ProxyAuth->new( authzID => q{dn:} . $authz ); + + $args{control} = [ @{ $args{control} || [] }, $authz ]; + } + # Handle server-side sorting - if (my $order_by = delete $args{order_by}) { - my $sort = Net::LDAP::Control::Sort->new(order => $order_by); + if ( my $order_by = delete $args{order_by} ) { + my $sort = Net::LDAP::Control::Sort->new( order => $order_by ); - $args{control} ||= []; - push @{ $args{control} }, $sort; + $args{control} = [ @{ $args{control} || [] }, $sort ]; } - my ($mesg, $pager); - if (my $page = delete $args{page}) { + my ( $mesg, $pager ); + if ( my $page = delete $args{page} ) { my $rows = delete $args{rows} || 25; my $vlv = Net::LDAP::Control::VLV->new( before => 0, after => $rows - 1, content => 0, - offset => ($rows * $page) - $rows + 1, + offset => ( $rows * $page ) - $rows + 1, ); - push @{ $args{control} }, $vlv; + $args{control} = [ @{ $args{control} || [] }, $vlv ]; $mesg = $self->next::method(%args); - my @resp = $mesg->control(LDAP_CONTROL_VLVRESPONSE) or - croak 'Could not get pager from LDAP response: ' . $mesg->server_error; - $pager = Data::Page->new($resp[0]->content, $rows, $page); + my @resp = $mesg->control(LDAP_CONTROL_VLVRESPONSE) + or croak 'Could not get pager from LDAP response: ' + . $mesg->server_error; + $pager = Data::Page->new( $resp[0]->content, $rows, $page ); } else { $mesg = $self->next::method(%args); } bless $mesg, 'Catalyst::Model::LDAP::Search'; - $mesg->init($self->entry_class); + $mesg->init( $self->entry_class ); - return ($pager ? ($mesg, $pager) : $mesg); + return ( $pager ? ( $mesg, $pager ) : $mesg ); } =head1 SEE ALSO @@ -233,6 +268,8 @@ =item * Marcus Ramberg (paging support) +=item * Gavin Henry <ghenry@surevoip.co.uk> (authz and raw support, plus bug fixes) + =back =head1 LICENSE Index: Makefile.PL =================================================================== --- Makefile.PL (revision 14560) +++ Makefile.PL (working copy) @@ -11,12 +11,13 @@ requires 'Class::Accessor::Fast'; requires 'Data::Page'; requires 'MRO::Compat'; -requires 'Net::LDAP' => '0.34'; +requires 'Net::LDAP' => '0.65'; requires 'Net::LDAP::Constant'; requires 'Net::LDAP::Control::Sort'; requires 'Net::LDAP::Control::VLV'; requires 'Net::LDAP::Entry'; requires 'Net::LDAP::Search'; +requires 'Net::LDAP::Control::ProxyAuth' => '1.09'; build_requires 'Data::Dumper'; build_requires 'FindBin'; Index: Changes =================================================================== --- Changes (revision 14560) +++ Changes (working copy) @@ -1,5 +1,15 @@ Revision history for Perl extension Catalyst::Model::LDAP. +0.18 Mon Sep 5 15:23:00 BST 2016 + - Authz added to support Net::LDAP::Control::ProxyAuth + - Raw option added to support UTF8 + https://rt.cpan.org/Public/Bug/Display.html?id=117219 + - Control option cleans ups to avoid duplicate elements + in the control array of Net::LDAP search objects + - Net::LDAP 0.65 added for min version as the current + required version is so old and does not support ProxyAuth + - Makefile.pl updated for ProxyAuth + 0.17 Thu Dec 3 16:48:27 EST 2009 - Fix a problem when the Entry and Connection classes live under the same app namespace, when COMPONENT gets