On Tue, Jun 17, 2008 at 5:16 PM, Graham Barr <[EMAIL PROTECTED]> wrote:
> On Jun 14, 2008, at 2:01 PM, Mathieu PARENT wrote:
>>
>> Hi,
>>
>> I have implemented LDAP Content Synchronization Operation (rfc4533) in
>> perl-ldap (See the attached patch). This is used by the OpenLDAP
>> server and provide features similar to Persistent Searches in a more
>> consistent way.
>>
>> This is my first try in this code, any feedback is welcome.
>
> It looks good. However the makefile is generated so we do not need a patch
> for that. And you should add your new files to the MANIFEST file.

Thanks. I've corrected this.

>> I don't know how to handle the Sync Info Message which is an LDAP
>> Intermediate Response Message (see 2.5 in RFC). perl-ldap doesn't
>> seems to support intermediate responses in response to LDAP::Search.
>> What is the way to correct this ?
>
> I have not read the RFC, but I assume this does not signal the end of the
> search
> operation, so the callback should be called.

Yes


> What is the content of the
> Intermediate Response Message ? There should probably be a class added to
> represent
> this message and that gets passed to the callback in the same way we do for
> entries and references.

I've added a Net::LDAP::Intermediate class (inspired by
net::LDAP::Control) with the ability to expand (for example
Net::LDAP::Intermediate::SyncInfo), see attached patch (work in
progress). This class is used from Net::LDAP::Search->decode().

The problem is that Convert::ASN1 doesn't understand this quite
complex BER script :

    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
          }
    }

with the attached "out" (which is working with enber/unber). Any idea
of where the problem comes from?

>
> Before I add this, I want to make the switch to Git from SVN. This will
> allow
> me to give better attribution to those who make contributions and also for
> people
> to contribute using git's mail patch mechanism which makes things easier.

I'll use git soon.

> I have converted the current SVN repository which you can find here
>
>  http://git.goingon.net/gitweb?p=perl-ldap.git;a=summary
>
> Graham.
>
>



Mathieu Parent

Attachment: out
Description: Binary data

diff -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/ASN.pm libnet-ldap-perl-0.36/lib/Net/LDAP/ASN.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/ASN.pm	2008-04-21 17:11:06.000000000 +0200
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/ASN.pm	2008-06-14 14:33:55.000000000 +0200
@@ -1,7 +1,7 @@
 
 package Net::LDAP::ASN;
 
-$VERSION = "0.06";
+$VERSION = "0.07";
 
 use Convert::ASN1;
 
@@ -440,6 +440,56 @@
 	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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Constant.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Constant.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Constant.pm	2008-04-21 17:11:06.000000000 +0200
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Constant.pm	2008-06-14 15:57:15.000000000 +0200
@@ -4,7 +4,7 @@
 
 package Net::LDAP::Constant;
 
-$VERSION = "0.06";
+$VERSION = "0.07";
 
 use Carp;
 
@@ -481,6 +481,14 @@
 
 =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 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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control/SyncDone.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Control/SyncDone.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control/SyncDone.pm	1970-01-01 01:00:00.000000000 +0100
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Control/SyncDone.pm	2008-06-14 17:50:59.000000000 +0200
@@ -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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control/SyncRequest.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Control/SyncRequest.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control/SyncRequest.pm	1970-01-01 01:00:00.000000000 +0100
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Control/SyncRequest.pm	2008-06-14 17:50:52.000000000 +0200
@@ -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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control/SyncState.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Control/SyncState.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control/SyncState.pm	1970-01-01 01:00:00.000000000 +0100
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Control/SyncState.pm	2008-06-14 17:50:49.000000000 +0200
@@ -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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Control.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Control.pm	2008-04-21 17:11:06.000000000 +0200
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Control.pm	2008-06-17 19:25:48.000000000 +0200
@@ -21,9 +21,12 @@
   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 @@
   '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::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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Intermediate/SyncInfo.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Intermediate/SyncInfo.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Intermediate/SyncInfo.pm	1970-01-01 01:00:00.000000000 +0100
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Intermediate/SyncInfo.pm	2008-06-17 22:35:08.000000000 +0200
@@ -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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Intermediate.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Intermediate.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Intermediate.pm	1970-01-01 01:00:00.000000000 +0100
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Intermediate.pm	2008-06-17 22:16:00.000000000 +0200
@@ -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 -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/lib/Net/LDAP/Search.pm libnet-ldap-perl-0.36/lib/Net/LDAP/Search.pm
--- libnet-ldap-perl-0.36-old/lib/Net/LDAP/Search.pm	2008-04-21 17:11:06.000000000 +0200
+++ libnet-ldap-perl-0.36/lib/Net/LDAP/Search.pm	2008-06-17 21:30:46.000000000 +0200
@@ -8,11 +8,12 @@
 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 @@
 
     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;
diff -urN --exclude=blib --exclude=debian --exclude '*~' --exclude Makefile libnet-ldap-perl-0.36-old/MANIFEST libnet-ldap-perl-0.36/MANIFEST
--- libnet-ldap-perl-0.36-old/MANIFEST	2008-04-21 17:14:14.000000000 +0200
+++ libnet-ldap-perl-0.36/MANIFEST	2008-06-17 19:20:23.000000000 +0200
@@ -60,6 +60,9 @@
 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/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

Reply via email to