[Catalyst-commits] r14561 - in trunk/Catalyst-Model-LDAP: . lib/Catalyst/Model lib/Catalyst/Model/LDAP

ghenry at dev.catalyst.perl.org ghenry at dev.catalyst.perl.org
Mon Sep 5 14:36:10 GMT 2016


Author: ghenry
Date: 2016-09-05 14:36:10 +0000 (Mon, 05 Sep 2016)
New Revision: 14561

Modified:
   trunk/Catalyst-Model-LDAP/Changes
   trunk/Catalyst-Model-LDAP/Makefile.PL
   trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP.pm
   trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP/Connection.pm
Log:
raw, authz new options. Docs, new reqs, control => [] cleanups and UTF-8 patch.

Modified: trunk/Catalyst-Model-LDAP/Changes
===================================================================
--- trunk/Catalyst-Model-LDAP/Changes	2015-12-07 14:50:06 UTC (rev 14560)
+++ trunk/Catalyst-Model-LDAP/Changes	2016-09-05 14:36:10 UTC (rev 14561)
@@ -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

Modified: trunk/Catalyst-Model-LDAP/Makefile.PL
===================================================================
--- trunk/Catalyst-Model-LDAP/Makefile.PL	2015-12-07 14:50:06 UTC (rev 14560)
+++ trunk/Catalyst-Model-LDAP/Makefile.PL	2016-09-05 14:36:10 UTC (rev 14561)
@@ -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';

Modified: trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP/Connection.pm
===================================================================
--- trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP/Connection.pm	2015-12-07 14:50:06 UTC (rev 14560)
+++ trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP/Connection.pm	2016-09-05 14:36:10 UTC (rev 14561)
@@ -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 at surevoip.co.uk> (authz and raw support, plus bug fixes)
+
 =back
 
 =head1 LICENSE

Modified: trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP.pm
===================================================================
--- trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP.pm	2015-12-07 14:50:06 UTC (rev 14560)
+++ trunk/Catalyst-Model-LDAP/lib/Catalyst/Model/LDAP.pm	2016-09-05 14:36:10 UTC (rev 14561)
@@ -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 at surevoip.co.uk> (authz and raw support, plus bug fixes)
+
 =back
 
 =head1 ACKNOWLEDGMENTS




More information about the Catalyst-commits mailing list