Hi,
This patch implements Intermediate Message and RFC 4533.
Notes:
- The only intrusive change is in lib/Net/LDAP/Search.pm
- Net::LDAP::Intermediate::SyncInfo is not enabled by default (see
lib/Net/LDAP/Intermediate.pm line 18) as there are decoding errors
within ASN (see my previous mail).
Waiting for feedback before (I hope) inclusion.
Regards
Mathieu Parent
---
MANIFEST | 5 +
lib/Net/LDAP/ASN.pm | 52 +++++++-
lib/Net/LDAP/Constant.pm | 46 ++++++-
lib/Net/LDAP/Control.pm | 15 ++-
lib/Net/LDAP/Control/SyncDone.pm | 152 +++++++++++++++++++++
lib/Net/LDAP/Control/SyncRequest.pm | 165 +++++++++++++++++++++++
lib/Net/LDAP/Control/SyncState.pm | 165 +++++++++++++++++++++++
lib/Net/LDAP/Intermediate.pm | 236 +++++++++++++++++++++++++++++++++
lib/Net/LDAP/Intermediate/SyncInfo.pm | 140 +++++++++++++++++++
lib/Net/LDAP/Search.pm | 14 ++-
10 files changed, 986 insertions(+), 4 deletions(-)
create mode 100644 lib/Net/LDAP/Control/SyncDone.pm
create mode 100644 lib/Net/LDAP/Control/SyncRequest.pm
create mode 100644 lib/Net/LDAP/Control/SyncState.pm
create mode 100644 lib/Net/LDAP/Intermediate.pm
create mode 100644 lib/Net/LDAP/Intermediate/SyncInfo.pm
diff --git a/MANIFEST b/MANIFEST
index 185ce57..161f716 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -60,6 +60,9 @@ lib/Net/LDAP/Control/PreRead.pm
lib/Net/LDAP/Control/ProxyAuth.pm
lib/Net/LDAP/Control/Sort.pm
lib/Net/LDAP/Control/SortResult.pm
+lib/Net/LDAP/Control/SyncDone.pm
+lib/Net/LDAP/Control/SyncRequest.pm
+lib/Net/LDAP/Control/SyncState.pm
lib/Net/LDAP/Control/VLV.pm
lib/Net/LDAP/Control/VLVResponse.pm
lib/Net/LDAP/DSML.pm
@@ -74,6 +77,8 @@ lib/Net/LDAP/FAQ.pod
lib/Net/LDAP/Filter.pm
lib/Net/LDAP/Filter.pod
lib/Net/LDAP/FilterMatch.pm
+lib/Net/LDAP/Intermediate.pm
+lib/Net/LDAP/Intermediate/SyncInfo.pm
lib/Net/LDAP/LDIF.pm
lib/Net/LDAP/LDIF.pod
lib/Net/LDAP/Message.pm
diff --git a/lib/Net/LDAP/ASN.pm b/lib/Net/LDAP/ASN.pm
index f894c13..82b7c17 100644
--- a/lib/Net/LDAP/ASN.pm
+++ b/lib/Net/LDAP/ASN.pm
@@ -1,7 +1,7 @@
package Net::LDAP::ASN;
-$VERSION = "0.06";
+$VERSION = "0.07";
use Convert::ASN1;
@@ -441,6 +441,56 @@ $asn->prepare(<<LDAP_ASN) or die $asn->error;
objectName LDAPDN,
attributes PartialAttributeList }
+ -- RFC-4533 LDAP Content Synchronization Operation
+
+ syncUUID ::= OCTET STRING -- (SIZE(16))
+
+ syncCookie ::= OCTET STRING
+
+ syncRequestValue ::= SEQUENCE {
+ mode ENUMERATED {
+ -- 0 unused
+ refreshOnly (1),
+ -- 2 reserved
+ refreshAndPersist (3)
+ }
+ cookie syncCookie OPTIONAL,
+ reloadHint BOOLEAN -- DEFAULT FALSE
+ }
+
+ syncStateValue ::= SEQUENCE {
+ state ENUMERATED {
+ present (0),
+ add (1),
+ modify (2),
+ delete (3)
+ }
+ entryUUID syncUUID,
+ cookie syncCookie OPTIONAL
+ }
+
+ syncDoneValue ::= SEQUENCE {
+ cookie syncCookie OPTIONAL,
+ refreshDeletes BOOLEAN -- DEFAULT FALSE
+ }
+
+ syncInfoValue ::= CHOICE {
+ newcookie [0] syncCookie,
+ refreshDelete [1] SEQUENCE {
+ refreshDeleteCookie syncCookie OPTIONAL,
+ refreshDeleteDone BOOLEAN -- DEFAULT TRUE
+ }
+ refreshPresent [2] SEQUENCE {
+ refreshDeletecookie syncCookie OPTIONAL,
+ refreshDeleteDone BOOLEAN -- DEFAULT TRUE
+ }
+ syncIdSet [3] SEQUENCE {
+ cookie syncCookie OPTIONAL,
+ refreshDeletes BOOLEAN, -- DEFAULT FALSE
+ syncUUIDs SET OF syncUUID
+ }
+ }
+
LDAP_ASN
1;
diff --git a/lib/Net/LDAP/Constant.pm b/lib/Net/LDAP/Constant.pm
index 6d84ab6..a9bebe9 100644
--- a/lib/Net/LDAP/Constant.pm
+++ b/lib/Net/LDAP/Constant.pm
@@ -4,7 +4,7 @@
package Net::LDAP::Constant;
-$VERSION = "0.06";
+$VERSION = "0.07";
use Carp;
@@ -481,6 +481,14 @@ The referral hop limit has been exceeded.
=item LDAP_CONTROL_ASSERTION (1.3.6.1.1.12)
+=item LDAP_CONTROL_SYNC (1.3.6.1.4.1.4203.1.9.1.1)
+
+=item LDAP_CONTROL_SYNC_STATE (1.3.6.1.4.1.4203.1.9.1.2)
+
+=item LDAP_CONTROL_SYNC_DONE (1.3.6.1.4.1.4203.1.9.1.3)
+
+=item LDAP_SYNC_INFO (1.3.6.1.4.1.4203.1.9.1.4)
+
=back
=head2 Control constants
@@ -523,6 +531,42 @@ The previous password was changed too recently.
The new password was used too recently.
+=item LDAP_SYNC_NONE (0) [LDAP_CONTROL_SYNC]
+
+=item LDAP_SYNC_REFRESH_ONLY (1) [LDAP_CONTROL_SYNC]
+
+=item LDAP_SYNC_RESERVED (2) [LDAP_CONTROL_SYNC]
+
+=item LDAP_SYNC_REFRESH_AND_PERSIST (3) [LDAP_CONTROL_SYNC]
+
+=item LDAP_SYNC_REFRESH_PRESENTS (0) [LDAP_SYNC_INFO]
+
+=item LDAP_SYNC_REFRESH_DELETES (1) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_SYNC_NEW_COOKIE (0x80) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_SYNC_REFRESH_DELETE (0xa1) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_SYNC_REFRESH_PRESENT (0xa2) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_SYNC_ID_SET (0xa3) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_SYNC_COOKIE (0x04) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_REFRESHDELETES (0x01) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_REFRESHDONE (0x01) [LDAP_SYNC_INFO]
+
+=item LDAP_TAG_RELOAD_HINT (0x01) [LDAP_CONTROL_SYNC]
+
+=item LDAP_SYNC_PRESENT (0) [LDAP_CONTROL_SYNC_STATE]
+
+=item LDAP_SYNC_ADD (1) [LDAP_CONTROL_SYNC_STATE]
+
+=item LDAP_SYNC_MODIFY (2) [LDAP_CONTROL_SYNC_STATE]
+
+=item LDAP_SYNC_DELETE (3) [LDAP_CONTROL_SYNC_STATE]
+
=back
=head2 Extension OIDs
diff --git a/lib/Net/LDAP/Control.pm b/lib/Net/LDAP/Control.pm
index 0cbbbef..c3b36e8 100644
--- a/lib/Net/LDAP/Control.pm
+++ b/lib/Net/LDAP/Control.pm
@@ -21,9 +21,12 @@ use Net::LDAP::Constant qw(
LDAP_CONTROL_PASSWORDPOLICY
LDAP_CONTROL_PREREAD
LDAP_CONTROL_POSTREAD
+ LDAP_CONTROL_SYNC
+ LDAP_CONTROL_SYNC_STATE
+ LDAP_CONTROL_SYNC_DONE
);
-$VERSION = "0.08";
+$VERSION = "0.09";
my %Pkg2Type = (
@@ -49,6 +52,10 @@ my %Pkg2Type = (
'Net::LDAP::Control::PreRead' => LDAP_CONTROL_PREREAD,
'Net::LDAP::Control::PostRead' => LDAP_CONTROL_POSTREAD,
+
+ 'Net::LDAP::Control::SyncRequest' => LDAP_CONTROL_SYNC,
+ 'Net::LDAP::Control::SyncState' => LDAP_CONTROL_SYNC_STATE,
+ 'Net::LDAP::Control::SyncDone' => LDAP_CONTROL_SYNC_DONE,
#
#LDAP_CONTROL_PWEXPIRED
#LDAP_CONTROL_PWEXPIRING
@@ -294,10 +301,16 @@ L<Net::LDAP>
L<Net::LDAP::Control::EntryChange>
L<Net::LDAP::Control::ManageDsaIT>
L<Net::LDAP::Control::Paged>
+L<Net::LDAP::Control::PasswordPolicy>
L<Net::LDAP::Control::PersistentSearch>
+L<Net::LDAP::Control::PostRead>
+L<Net::LDAP::Control::PreRead>
L<Net::LDAP::Control::ProxyAuth>
L<Net::LDAP::Control::Sort>
L<Net::LDAP::Control::SortResult>
+L<Net::LDAP::Control::SyncDone>
+L<Net::LDAP::Control::SyncRequest>
+L<Net::LDAP::Control::SyncState>
L<Net::LDAP::Control::VLV>
L<Net::LDAP::Control::VLVResponse>
diff --git a/lib/Net/LDAP/Control/SyncDone.pm b/lib/Net/LDAP/Control/SyncDone.pm
new file mode 100644
index 0000000..7fcb0d9
--- /dev/null
+++ b/lib/Net/LDAP/Control/SyncDone.pm
@@ -0,0 +1,152 @@
+# Copyright (c) 2008 Mathieu Parent <[EMAIL PROTECTED]>. All
rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Net::LDAP::Control::SyncDone;
+
+use vars qw(@ISA $VERSION);
+use Net::LDAP::Control;
+
[EMAIL PROTECTED] = qw(Net::LDAP::Control);
+$VERSION = "0.01";
+
+use Net::LDAP::ASN qw(syncDoneValue);
+use strict;
+
+# use some kind of hack here:
+# - calling the control without args means: response,
+# - giving an argument: means: request
+sub init {
+ my($self) = @_;
+
+ delete $self->{asn};
+
+ unless (exists $self->{value}) {
+ $self->{asn} = {
+ cookie => $self->{cookie} || '',
+ refreshDeletes => $self->{refreshDeletes} || '0',
+ };
+ }
+
+ $self;
+}
+
+sub cookie {
+ my $self = shift;
+ $self->{asn} ||= $syncDoneValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{cookie} = shift || 0;
+ }
+ $self->{asn}{cookie};
+}
+
+sub refreshDeletes {
+ my $self = shift;
+ $self->{asn} ||= $syncDoneValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{refreshDeletes} = shift || 0;
+ }
+ $self->{asn}{refreshDeletes};
+}
+
+sub value {
+ my $self = shift;
+
+ exists $self->{value}
+ ? $self->{value}
+ : $self->{value} = $syncDoneValue->encode($self->{asn});
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Net::LDAP::Control::SyncDone - LDAPv3 Sync Done control object
+
+=head1 SYNOPSIS
+
+ use Net::LDAP;
+ use Net::LDAP::Control::SyncRequest;
+ use Net::LDAP::Constant qw(
+ LDAP_SYNC_REFRESH_ONLY
+ LDAP_SYNC_REFRESH_AND_PERSIST
+ LDAP_SUCCESS );
+
+ $ldap = Net::LDAP->new( "ldap.mydomain.eg" );
+
+ $req = Net::LDAP::Control::SyncRequest->new( mode => LDAP_SYNC_REFRESH_ONLY );
+ my $mesg = $ldap->search(base=> 'dc=mydomain,dc='eg',
+ scope => 'sub',
+ control => [ $req ],
+ callback => \&searchCallback, # call for each entry
+ filter => "(objectClass=*)",
+ attrs => [ '*']);
+ sub searchCallback {
+ my $message = shift;
+ my $entry = shift;
+ my @controls = $message->control;
+
+ if($controls[0]->isa('Net::LDAP::Control::SyncState')) {
+ print "Received Sync State Control\n";
+ print $entry->dn()."\n";
+ print 'State: '.$controls[0]->state."\n".', entryUUID:
'.$controls[0]->entryUUID.', cookie: '.$controls[0]->cookie;
+ } elsif($controls[0]->isa('Net::LDAP::Control::SyncDone')) {
+ print "Received Sync Done Control\n";
+ print 'Cookie: '.$controls[0]->cookie.', refreshDeletes:
'.$controls[0]->refreshDeletes;
+ }
+ }
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Control::SyncDone> provides an interface for the creation and
+manipulation of objects that represent the C<Sync Request Control> as described
+by RFC 4533.
+
+=head1 CONSTRUCTOR ARGUMENTS
+
+In addition to the constructor arguments described in
+L<Net::LDAP::Control> the following are provided.
+
+=over 4
+
+=item cookie
+
+=item refreshDeletes
+
+=back
+
+=head1 METHODS
+
+As with L<Net::LDAP::Control> each constructor argument
+described above is also avaliable as a method on the object which will
+return the current value for the attribute if called without an argument,
+and set a new value for the attribute if called with an argument.
+
+=head1 SEE ALSO
+
+L<Net::LDAP>,
+L<Net::LDAP::Control>,
+L<Net::LDAP::Control::SyncRequest>,
+L<Net::LDAP::Control::SyncState>,
+http://www.ietf.org/rfc/rfc4533.txt
+
+=head1 AUTHOR
+
+Mathieu Parent E<lt>[EMAIL PROTECTED]<gt>
+
+Please report any bugs, or post any suggestions, to the perl-ldap mailing list
+E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Mathieu Parent. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
diff --git a/lib/Net/LDAP/Control/SyncRequest.pm
b/lib/Net/LDAP/Control/SyncRequest.pm
new file mode 100644
index 0000000..b33868d
--- /dev/null
+++ b/lib/Net/LDAP/Control/SyncRequest.pm
@@ -0,0 +1,165 @@
+# Copyright (c) 2008 Mathieu Parent <[EMAIL PROTECTED]>. All
rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Net::LDAP::Control::SyncRequest;
+
+use vars qw(@ISA $VERSION);
+use Net::LDAP::Control;
+
[EMAIL PROTECTED] = qw(Net::LDAP::Control);
+$VERSION = "0.01";
+
+use Net::LDAP::ASN qw(syncRequestValue);
+use strict;
+
+# use some kind of hack here:
+# - calling the control without args means: response,
+# - giving an argument: means: request
+sub init {
+ my($self) = @_;
+
+ delete $self->{asn};
+
+ unless (exists $self->{value}) {
+ $self->{asn} = {
+ mode => $self->{mode} || '1',
+ cookie => $self->{cookie} || '',
+ reloadHint => $self->{reloadHint} || '0',
+ };
+ }
+
+ $self;
+}
+
+sub mode {
+ my $self = shift;
+ $self->{asn} ||= $syncRequestValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{mode} = shift || 0;
+ }
+ $self->{asn}{mode};
+}
+
+sub cookie {
+ my $self = shift;
+ $self->{asn} ||= $syncRequestValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{cookie} = shift || 0;
+ }
+ $self->{asn}{cookie};
+}
+
+sub reloadHint {
+ my $self = shift;
+ $self->{asn} ||= $syncRequestValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{reloadHint} = shift || 0;
+ }
+ $self->{asn}{reloadHint};
+}
+
+sub value {
+ my $self = shift;
+
+ exists $self->{value}
+ ? $self->{value}
+ : $self->{value} = $syncRequestValue->encode($self->{asn});
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Net::LDAP::Control::SyncRequest - LDAPv3 Sync Request control object
+
+=head1 SYNOPSIS
+
+ use Net::LDAP;
+ use Net::LDAP::Control::SyncRequest;
+ use Net::LDAP::Constant qw(
+ LDAP_SYNC_REFRESH_ONLY
+ LDAP_SYNC_REFRESH_AND_PERSIST
+ LDAP_SUCCESS );
+
+ $ldap = Net::LDAP->new( "ldap.mydomain.eg" );
+
+ $req = Net::LDAP::Control::SyncRequest->new( mode => LDAP_SYNC_REFRESH_ONLY );
+ my $mesg = $ldap->search(base=> 'dc=mydomain,dc='eg',
+ scope => 'sub',
+ control => [ $req ],
+ callback => \&searchCallback, # call for each entry
+ filter => "(objectClass=*)",
+ attrs => [ '*']);
+ sub searchCallback {
+ my $message = shift;
+ my $entry = shift;
+ my @controls = $message->control;
+
+ if($controls[0]->isa('Net::LDAP::Control::SyncState')) {
+ print "Received Sync State Control\n";
+ print $entry->dn()."\n";
+ print 'State: '.$controls[0]->state."\n".', entryUUID:
'.$controls[0]->entryUUID.', cookie: '.$controls[0]->cookie;
+ } elsif($controls[0]->isa('Net::LDAP::Control::SyncDone')) {
+ print "Received Sync Done Control\n";
+ print 'Cookie: '.$controls[0]->cookie.', refreshDeletes:
'.$controls[0]->refreshDeletes;
+ }
+ }
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Control::SyncRequest> provides an interface for the creation and
+manipulation of objects that represent the C<Sync Request Control> as described
+by RFC 4533.
+
+=head1 CONSTRUCTOR ARGUMENTS
+
+In addition to the constructor arguments described in
+L<Net::LDAP::Control> the following are provided.
+
+=over 4
+
+=item mode
+
+=item cookie
+
+=item reloadHint
+
+=back
+
+=head1 METHODS
+
+As with L<Net::LDAP::Control> each constructor argument
+described above is also avaliable as a method on the object which will
+return the current value for the attribute if called without an argument,
+and set a new value for the attribute if called with an argument.
+
+=head1 SEE ALSO
+
+L<Net::LDAP>,
+L<Net::LDAP::Control>,
+L<Net::LDAP::Control::SyncState>,
+L<Net::LDAP::Control::SyncDone>,
+http://www.ietf.org/rfc/rfc4533.txt
+
+=head1 AUTHOR
+
+Mathieu Parent E<lt>[EMAIL PROTECTED]<gt>
+
+Please report any bugs, or post any suggestions, to the perl-ldap mailing list
+E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Mathieu Parent. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
diff --git a/lib/Net/LDAP/Control/SyncState.pm
b/lib/Net/LDAP/Control/SyncState.pm
new file mode 100644
index 0000000..b069e42
--- /dev/null
+++ b/lib/Net/LDAP/Control/SyncState.pm
@@ -0,0 +1,165 @@
+# Copyright (c) 2008 Mathieu Parent <[EMAIL PROTECTED]>. All
rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Net::LDAP::Control::SyncState;
+
+use vars qw(@ISA $VERSION);
+use Net::LDAP::Control;
+
[EMAIL PROTECTED] = qw(Net::LDAP::Control);
+$VERSION = "0.01";
+
+use Net::LDAP::ASN qw(syncStateValue);
+use strict;
+
+# use some kind of hack here:
+# - calling the control without args means: response,
+# - giving an argument: means: request
+sub init {
+ my($self) = @_;
+
+ delete $self->{asn};
+
+ unless (exists $self->{value}) {
+ $self->{asn} = {
+ state => $self->{state} || '',
+ entryUUID => $self->{entryUUID} || '',
+ cookie => $self->{cookie} || '',
+ };
+ }
+
+ $self;
+}
+
+sub state {
+ my $self = shift;
+ $self->{asn} ||= $syncStateValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{state} = shift || 0;
+ }
+ $self->{asn}{state};
+}
+
+sub entryUUID {
+ my $self = shift;
+ $self->{asn} ||= $syncStateValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{entryUUID} = shift || 0;
+ }
+ $self->{asn}{entryUUID};
+}
+
+sub cookie {
+ my $self = shift;
+ $self->{asn} ||= $syncStateValue->decode($self->{value});
+ if (@_) {
+ delete $self->{value};
+ return $self->{asn}{cookie} = shift || 0;
+ }
+ $self->{asn}{cookie};
+}
+
+sub value {
+ my $self = shift;
+
+ exists $self->{value}
+ ? $self->{value}
+ : $self->{value} = $syncStateValue->encode($self->{asn});
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Net::LDAP::Control::SyncState - LDAPv3 Sync State control object
+
+=head1 SYNOPSIS
+
+ use Net::LDAP;
+ use Net::LDAP::Control::SyncRequest;
+ use Net::LDAP::Constant qw(
+ LDAP_SYNC_REFRESH_ONLY
+ LDAP_SYNC_REFRESH_AND_PERSIST
+ LDAP_SUCCESS );
+
+ $ldap = Net::LDAP->new( "ldap.mydomain.eg" );
+
+ $req = Net::LDAP::Control::SyncRequest->new( mode => LDAP_SYNC_REFRESH_ONLY );
+ my $mesg = $ldap->search(base=> 'dc=mydomain,dc='eg',
+ scope => 'sub',
+ control => [ $req ],
+ callback => \&searchCallback, # call for each entry
+ filter => "(objectClass=*)",
+ attrs => [ '*']);
+ sub searchCallback {
+ my $message = shift;
+ my $entry = shift;
+ my @controls = $message->control;
+
+ if($controls[0]->isa('Net::LDAP::Control::SyncState')) {
+ print "Received Sync State Control\n";
+ print $entry->dn()."\n";
+ print 'State: '.$controls[0]->state."\n".', entryUUID:
'.$controls[0]->entryUUID.', cookie: '.$controls[0]->cookie;
+ } elsif($controls[0]->isa('Net::LDAP::Control::SyncDone')) {
+ print "Received Sync Done Control\n";
+ print 'Cookie: '.$controls[0]->cookie.', refreshDeletes:
'.$controls[0]->refreshDeletes;
+ }
+ }
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Control::SyncState> provides an interface for the creation and
+manipulation of objects that represent the C<Sync State Control> as described
+by RFC 4533.
+
+=head1 CONSTRUCTOR ARGUMENTS
+
+In addition to the constructor arguments described in
+L<Net::LDAP::Control> the following are provided.
+
+=over 4
+
+=item state
+
+=item entryUIID
+
+=item cookie
+
+=back
+
+=head1 METHODS
+
+As with L<Net::LDAP::Control> each constructor argument
+described above is also avaliable as a method on the object which will
+return the current value for the attribute if called without an argument,
+and set a new value for the attribute if called with an argument.
+
+=head1 SEE ALSO
+
+L<Net::LDAP>,
+L<Net::LDAP::Control>,
+L<Net::LDAP::Control::SyncRequest>,
+L<Net::LDAP::Control::SyncDone>,
+http://www.ietf.org/rfc/rfc4533.txt
+
+=head1 AUTHOR
+
+Mathieu Parent E<lt>[EMAIL PROTECTED]<gt>
+
+Please report any bugs, or post any suggestions, to the perl-ldap mailing list
+E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Mathieu Parent. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
diff --git a/lib/Net/LDAP/Intermediate.pm b/lib/Net/LDAP/Intermediate.pm
new file mode 100644
index 0000000..b95b849
--- /dev/null
+++ b/lib/Net/LDAP/Intermediate.pm
@@ -0,0 +1,236 @@
+# Copyright (c) 2008 Mathieu Parent <[EMAIL PROTECTED]>. All
rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Net::LDAP::Intermediate;
+
+use vars qw($VERSION);
+use strict;
+
+use Net::LDAP::Constant qw(
+ LDAP_SYNC_INFO
+);
+
+$VERSION = "0.01";
+
+my %Class2ResponseName = (
+
+ #'Net::LDAP::Intermediate::SyncInfo' => LDAP_SYNC_INFO, #disabled
as decoding doesn't work
+);
+
+my %ResponseName2Class = reverse %Class2ResponseName;
+
+sub register {
+ my($class,$responseName) = @_;
+
+ require Carp and Carp::croak("$responseName is already registered
to $ResponseName2Class{$responseName}")
+ if exists $ResponseName2Class{$responseName} and
$ResponseName2Class{$responseName} ne $class;
+
+ require Carp and Carp::croak("$class is already registered to
$Class2ResponseName{$class}")
+ if exists $Class2ResponseName{$class} and
$Class2ResponseName{$class} ne $responseName;
+
+ $ResponseName2Class{$responseName} = $class;
+ $Class2ResponseName{$class} = $responseName;
+}
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $responseName = (@_ & 1) ? shift : undef;
+ my %args = @_;
+
+ $args{'responseName'} ||= $responseName || $Class2ResponseName{$class} || '';
+
+ unless ($args{responseName} =~ /^\d+(?:\.\d+)+$/) {
+ $args{error} = 'Invalid responseName';
+ return bless \%args;
+ }
+
+ if ($class eq __PACKAGE__ and exists
$ResponseName2Class{$args{responseName}}) {
+ $class = $ResponseName2Class{$args{responseName}};
+ eval "require $class" or die $@;
+ }
+
+ delete $args{error};
+
+ bless(\%args, $class)->init;
+}
+
+
+sub from_asn {
+ my $self = shift;
+ my $asn = shift;
+ my $class = ref($self) || $self;
+
+ if ($class eq __PACKAGE__ and exists
$ResponseName2Class{$asn->{responseName}}) {
+ $class = $ResponseName2Class{$asn->{responseName}};
+ eval "require $class" or die $@;
+ }
+
+ delete $asn->{error};
+
+ bless($asn, $class)->init;
+}
+
+sub to_asn {
+ my $self = shift;
+ $self->responseValue; # Ensure value is there
+ $self;
+}
+
+sub responseName { shift->{responseName} }
+
+sub responseValue {
+ my $self = shift;
+ $self->{responseValue} = shift if @_;
+ $self->{responseValue} || undef
+}
+
+sub valid { ! exists shift->{error} }
+sub error { shift->{error} }
+sub init { shift }
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Net::LDAP::Intermediate - LDAPv3 intermediate response object base class
+
+=head1 SYNOPSIS
+
+ use Net::LDAP::Intermediate;
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Intermediate> is a base-class for LDAPv3 intermediate
response objects.
+
+=cut
+
+##
+## Need more blurb in here about intermediate responses
+##
+
+=head1 CONSTRUCTORS
+
+=over 4
+
+=item new ( ARGS )
+
+ARGS is a list of name/value pairs, valid arguments are:
+
+=over 4
+
+=item responseName
+
+A dotted-decimal representation of an OBJECT IDENTIFIER which
+uniquely identifies the intermediate response. This prevents conflicts between
+intermediate response names.
+
+=item responseValue
+
+Optional information associated with the intermediate response. It's
format is specific
+to the particular intermediate response.
+
+=back
+
+=item from_asn ( ASN )
+
+ASN is a HASH reference, normally extracted from a PDU. It will contain
+a C<responseName> element and optionally C<responseValue> element. On
+return ASN will be blessed into a package. If C<responseName> is a registered
+OID, then ASN will be blessed into the registered package, if not then ASN
+will be blessed into Net::LDAP::Intermediate.
+
+This constructor is used internally by Net::LDAP and assumes that HASH
+passed contains a valid intermediate response. It should be used with
B<caution>.
+
+=back
+
+=head1 METHODS
+
+In addition to the methods listed below, each of the named parameters
+to C<new> is also avaliable as a method. C<responseName> will return the OID of
+the intermediate response object. C<responseValue> is set/get methods and will
+return the current value for each attribute if called without arguments,
+but may also be called with arguments to set new values.
+
+=over 4
+
+=item error ()
+
+If there has been an error returns a description of the error,
otherwise it will
+return C<undef>
+
+=item init ()
+
+C<init> will be called as the last step in both contructors. What it
does will depend
+on the sub-class. It must always return the object.
+
+=item register ( OID )
+
+C<register> is provided for sub-class implementors. It should be
called as a class method
+on a sub-class of Net::LDAP::Intermediate with the OID that the class
will handle. Net::LDAP::Intermediate
+will remember this class and OID pair and use it in the following
+situations.
+
+=over 4
+
+=item *
+
+C<new> is called as a class method on the Net::LDAP::Intermediate
package and OID is passed
+as the responseName. The returned object will be blessed into the
package that registered
+the OID.
+
+=item *
+
+C<new> is called as a class method on a registered package and the
C<responseName> is not
+specified. The C<responseName> will be set to the OID registered by
that package.
+
+=item *
+
+C<from_asn> is called to construct an object from ASN. The returned
object will be
+blessed into the package which was registered to handle the OID in the ASN.
+
+=back
+
+=item ( to_asn )
+
+Returns a structure suitable for passing to Convert::ASN1 for
+encoding. This method will be called by L<Net::LDAP> when the
+intermediate response is used.
+
+The base class implementation of this method will call the
C<responseValue> method
+without arguments to allow a sub-class to encode it's value. Sub-classes
+should not need to override this method.
+
+=item valid ()
+
+Returns true if the object is valid and can be encoded. The default
implementation
+for this method is to return TRUE if there is no error, but
sub-classes may override that.
+
+=back
+
+=head1 SEE ALSO
+
+L<Net::LDAP>
+L<Net::LDAP::Extension>
+L<Net::LDAP::Search>
+L<Net::LDAP::Intermediate::SyncInfo>
+
+=head1 AUTHOR
+
+Mathieu Parent E<lt>[EMAIL PROTECTED]<gt>
+
+Please report any bugs, or post any suggestions, to the perl-ldap mailing list
+E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Mathieu Parent. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
diff --git a/lib/Net/LDAP/Intermediate/SyncInfo.pm
b/lib/Net/LDAP/Intermediate/SyncInfo.pm
new file mode 100644
index 0000000..ed8205a
--- /dev/null
+++ b/lib/Net/LDAP/Intermediate/SyncInfo.pm
@@ -0,0 +1,140 @@
+# Copyright (c) 2008 Mathieu Parent <[EMAIL PROTECTED]>. All
rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Net::LDAP::Intermediate::SyncInfo;
+
+use vars qw(@ISA $VERSION);
+use Net::LDAP::Intermediate;
+
[EMAIL PROTECTED] = qw(Net::LDAP::Intermediate);
+$VERSION = "0.01";
+
+use Net::LDAP::ASN qw(syncInfoValue);
+use strict;
+
+# use some kind of hack here:
+# - calling the control without args means: response,
+# - giving an argument: means: request
+sub init {
+ my($self) = @_;
+
+ delete $self->{asn};
+
+ unless (exists $self->{responseValue}) {
+ $self->{asn} = {
+ newcookie => $self->{newcookie} || '',
+ };
+ }
+
+ $self;
+}
+
+sub newcookie {
+ my $self = shift;
+ $self->{asn} ||= $syncInfoValue->decode($self->{responseValue});
+ if (@_) {
+ delete $self->{responseValue};
+ return $self->{asn}{newcookie} = shift || 0;
+ }
+ $self->{asn}{cookie};
+}
+
+sub responseValue {
+ my $self = shift;
+
+ exists $self->{responseValue}
+ ? $self->{responseValue}
+ : $self->{responseValue} = $syncInfoValue->encode($self->{asn});
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Net::LDAP::Intermediate::SyncInfo - LDAPv3 Sync Info Message object
+
+=head1 SYNOPSIS
+
+ use Net::LDAP;
+ use Net::LDAP::Control::SyncRequest;
+ use Net::LDAP::Constant qw(
+ LDAP_SYNC_REFRESH_ONLY
+ LDAP_SYNC_REFRESH_AND_PERSIST
+ LDAP_SUCCESS );
+
+ $ldap = Net::LDAP->new( "ldap.mydomain.eg" );
+
+ $req = Net::LDAP::Control::SyncRequest->new( mode => LDAP_SYNC_REFRESH_ONLY );
+ my $mesg = $ldap->search(base=> 'dc=mydomain,dc='eg',
+ scope => 'sub',
+ control => [ $req ],
+ callback => \&searchCallback, # call for each entry
+ filter => "(objectClass=*)",
+ attrs => [ '*']);
+ sub searchCallback {
+ my $message = shift;
+ my $entry = shift;
+ my @controls = $message->control;
+
+ if($controls[0]->isa('Net::LDAP::Control::SyncState')) {
+ print "Received Sync State Control\n";
+ print $entry->dn()."\n";
+ print 'State: '.$controls[0]->state."\n".', entryUUID:
'.$controls[0]->entryUUID.', cookie: '.$controls[0]->cookie;
+ } elsif($controls[0]->isa('Net::LDAP::Control::SyncDone')) {
+ print "Received Sync Done Control\n";
+ print 'Cookie: '.$controls[0]->cookie.', refreshDeletes:
'.$controls[0]->refreshDeletes;
+ }
+ }
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Intermediate::SyncInfo> provides an interface for the creation and
+manipulation of objects that represent the C<Sync Info Message> as described
+by RFC 4533.
+
+=head1 CONSTRUCTOR ARGUMENTS
+
+In addition to the constructor arguments described in
+L<Net::LDAP::Intermediate> the following are provided.
+
+=over 4
+
+=item TODO
+
+=back
+
+=head1 METHODS
+
+As with L<Net::LDAP::Intermediate> each constructor argument
+described above is also avaliable as a method on the object which will
+return the current value for the attribute if called without an argument,
+and set a new value for the attribute if called with an argument.
+
+=head1 SEE ALSO
+
+L<Net::LDAP>,
+L<Net::LDAP::Intermediate>,
+L<Net::LDAP::Control>,
+L<Net::LDAP::Control::SyncRequest>,
+L<Net::LDAP::Control::SyncState>,
+http://www.ietf.org/rfc/rfc4533.txt
+
+=head1 AUTHOR
+
+Mathieu Parent E<lt>[EMAIL PROTECTED]<gt>
+
+Please report any bugs, or post any suggestions, to the perl-ldap mailing list
+E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Mathieu Parent. All rights reserved. This program is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
diff --git a/lib/Net/LDAP/Search.pm b/lib/Net/LDAP/Search.pm
index ed1617b..d8c3568 100644
--- a/lib/Net/LDAP/Search.pm
+++ b/lib/Net/LDAP/Search.pm
@@ -8,11 +8,12 @@ use strict;
use vars qw(@ISA $VERSION);
use Net::LDAP::Message;
use Net::LDAP::Entry;
+use Net::LDAP::Intermediate;
use Net::LDAP::Filter;
use Net::LDAP::Constant qw(LDAP_SUCCESS LDAP_DECODING_ERROR);
@ISA = qw(Net::LDAP::Message);
-$VERSION = "0.11";
+$VERSION = "0.12";
sub first_entry { # compat
@@ -63,6 +64,17 @@ sub decode {
return $self;
}
+ elsif ($data = delete $result->{protocolOp}{intermediateResponse}) {
+
+ my $intermediate = Net::LDAP::Intermediate->from_asn($data);
+
+ push(@{$self->{'intermediate'} ||= []}, [$intermediate]);
+
+ $self->{callback}->($self, $intermediate)
+ if (defined $self->{callback});
+
+ return $self;
+ }
$self->set_error(LDAP_DECODING_ERROR, "LDAP decode error");
return;
--
1.5.6
