I've attached a patch(against perl-ldap-0.34) implementing the modify/increment operation and the PreRead/PostRead controls from RFCs 4525 and 4527.
I'm having a little trouble with the ASN definition for the Read control request, but the operation is still successful and the controls return the full entry(instead of just the attributes I ask for). I've also attached a code skeleton demostrating usage. Does anybody have suggestions or comments? Is there any possibility of merging this into perl-ldap? Thanks, -Stephen
testinc.pl
Description: Perl program
diff -Nur perl-ldap-0.34/lib/Net/LDAP/ASN.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/ASN.pm
--- perl-ldap-0.34/lib/Net/LDAP/ASN.pm 2007-02-10 15:44:18.000000000 -0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/ASN.pm 2007-09-11
13:27:25.000000000 -0700
@@ -412,6 +412,16 @@
type [2] AttributeDescription OPTIONAL,
--- at least one of the above must be present
matchValue [3] AssertionValue }
+
+ -- RFC 4527 - Read Control messages
+ ReadControlRequest ::= SEQUENCE {
+ attrs AttributeDescriptionList
+ }
+
+ ReadControlResponse ::= SEQUENCE {
+ objectName LDAPDN,
+ attributes AttributeList
+ }
LDAP_ASN
diff -Nur perl-ldap-0.34/lib/Net/LDAP/Constant.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/Constant.pm
--- perl-ldap-0.34/lib/Net/LDAP/Constant.pm 2007-02-10 15:44:18.000000000
-0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/Constant.pm 2007-09-06
18:46:03.000000000 -0700
@@ -473,6 +473,10 @@
=item LDAP_CONTROL_REFERRALS (1.2.840.113556.1.4.616)
+=item LDAP_CONTROL_PREREAD (1.3.6.1.1.13.1)
+
+=item LDAP_CONTROL_POSTREAD (1.3.6.1.1.13.2)
+
=back
=head2 Extension OIDs
diff -Nur perl-ldap-0.34/lib/Net/LDAP/Control/PostRead.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/Control/PostRead.pm
--- perl-ldap-0.34/lib/Net/LDAP/Control/PostRead.pm 1969-12-31
16:00:00.000000000 -0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/Control/PostRead.pm
2007-09-11 13:41:27.000000000 -0700
@@ -0,0 +1,141 @@
+# Copyright (c) 2007 Stephen Hock <[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::PostRead;
+
+use vars qw(@ISA $VERSION);
+use Net::LDAP::Control;
+use Net::LDAP::Entry;
+
[EMAIL PROTECTED] = qw(Net::LDAP::Control);
+$VERSION = "0.01";
+
+use Net::LDAP::Constant qw(LDAP_CONTROL_POSTREAD);
+use Net::LDAP::ASN qw(ReadControlRequest ReadControlResponse);
+use Net::LDAP::Entry;
+use strict;
+use Data::Dumper;
+
+sub init {
+ my ($self) = @_;
+
+ delete $self->{asn};
+
+ if (exists $self->{attrs}) {
+ $self->{asn} = {attrs => $self->{attrs}};
+ $self->{value} = $ReadControlRequest->encode($self->{asn});
+ die $ReadControlRequest->error if !defined $self->{value};
+ }
+
+ return $self;
+}
+
+sub attrs {
+ my $self = shift;
+ $self->{attrs} = shift if @_;
+
+ return $self->{attrs};
+}
+
+
+sub entry {
+ my $self = shift;
+ $self->{asn} = $ReadControlResponse->decode($self->{value}) or
+ die "Can't decode: " . $ReadControlResponse->error;
+
+ my $e = Net::LDAP::Entry->new();
+
+ $e->decode($self->{asn});
+ return $e;
+}
+
+sub value {
+ my $self = shift;
+ if(@_) { $self->{value} = $_; }
+
+ return $self->{value};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::LDAP::Control::PostRead - LDAPv3 PostRead control object
+
+=head1 SYNOPSIS
+
+ use Net::LDAP;
+ use Net::LDAP::Entry;
+ use Net::LDAP::Control::PostRead;
+ use Net::LDAP::Constant qw(LDAP_CONTROL_POSTREAD);
+
+ $ldap = Net::LDAP->new( "ldap.mydomain.eg" );
+ $postread = Net::LDAP::Control::PostRead->new(critical => 1);
+
+ $entry->increment("integerAttribute", $amount);
+ $mesg = $entry->update($ldap, control => $postread);
+
+ if($mesg->code) {
+ die "Error: " . $mesg->error_text . "\n";
+ }
+
+ # Retrieve the entry from the control
+ ($control) = $mesg->control(LDAP_CONTROL_POSTREAD);
+ $entry = $control->entry;
+ print $entry->get_value("integerAttribute");
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Control::PostRead> provides an interface for the creation and
manipulation of objects that represent the C<postRead> as described by
draft-zeilenga-ldap-readentry-04.txt.
+
+=head1 CONSTRUCTOR ARGUMENTS
+
+In addition to the constructor arguments described in
+L<Net::LDAP::Control> the following are provided.
+
+=over 4
+
+=item attrs
+
+The attribute return list.
+
+=back
+
+B<Please note:>
+
+=head1 METHODS
+
+As with L<Net::LDAP::Control> each constructor argument described above is
+also available 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.
+
+=item entry
+
+Return the L<Net::LDAP::Entry> object from the PostRead control response.
+
+=head1 SEE ALSO
+
+L<Net::LDAP>,
+L<Net::LDAP::Control>,
+
+=head1 AUTHOR
+
+Stephen Hock, based on Net::LDAP::Control::ProxyAuth from
+Graham Barr 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) 2007 Stephen Hock <[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.
+
+=cut
+
+
diff -Nur perl-ldap-0.34/lib/Net/LDAP/Control/PreRead.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/Control/PreRead.pm
--- perl-ldap-0.34/lib/Net/LDAP/Control/PreRead.pm 1969-12-31
16:00:00.000000000 -0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/Control/PreRead.pm
2007-09-11 13:46:29.000000000 -0700
@@ -0,0 +1,139 @@
+# Copyright (c) 2007 Stephen Hock <[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::PreRead;
+
+use vars qw(@ISA $VERSION);
+use Net::LDAP::Control;
+use Net::LDAP::Entry;
+
[EMAIL PROTECTED] = qw(Net::LDAP::Control);
+$VERSION = "0.01";
+
+use Net::LDAP::Constant qw(LDAP_CONTROL_PREREAD);
+use Net::LDAP::ASN qw(ReadControlRequest ReadControlResponse);
+use Net::LDAP::Entry;
+use strict;
+use Data::Dumper;
+
+sub init {
+ my ($self) = @_;
+
+ delete $self->{asn};
+
+ if (exists $self->{attrs}) {
+ $self->{asn} = {attrs => $self->{attrs}};
+ $self->{value} = $ReadControlRequest->encode($self->{asn});
+ die $ReadControlRequest->error if !defined $self->{value};
+ }
+
+ return $self;
+}
+
+sub attrs {
+ my $self = shift;
+ $self->{attrs} = shift if @_;
+
+ return $self->{attrs};
+}
+
+
+sub entry {
+ my $self = shift;
+ $self->{asn} = $ReadControlResponse->decode($self->{value}) or
+ die "Can't decode: " . $ReadControlResponse->error;
+
+ my $e = Net::LDAP::Entry->new();
+
+ $e->decode($self->{asn});
+ return $e;
+}
+
+sub value {
+ my $self = shift;
+ if(@_) { $self->{value} = $_; }
+
+ return $self->{value};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::LDAP::Control::PreRead - LDAPv3 PreRead control object
+
+=head1 SYNOPSIS
+
+ use Net::LDAP;
+ use Net::LDAP::Entry;
+ use Net::LDAP::Control::PreRead;
+ use Net::LDAP::Constant qw(LDAP_CONTROL_PREREAD);
+
+ $ldap = Net::LDAP->new( "ldap.mydomain.eg" );
+ $preread = Net::LDAP::Control::PreRead->new(critical => 1);
+
+ $entry->increment("integerAttribute", $amount);
+ $mesg = $entry->update($ldap, control => $preread);
+
+ if($mesg->code) {
+ die "Error: " . $mesg->error_text . "\n";
+ }
+
+ # Retrieve the entry from the control
+ ($control) = $mesg->control(LDAP_CONTROL_PREREAD);
+ $entry = $control->entry;
+ print $entry->get_value("integerAttribute");
+
+=head1 DESCRIPTION
+
+C<Net::LDAP::Control::PreRead> provides an interface for the creation and
manipulation of objects that represent the C<preRead> as described by
draft-zeilenga-ldap-readentry-04.txt.
+
+=head1 CONSTRUCTOR ARGUMENTS
+
+In addition to the constructor arguments described in
+L<Net::LDAP::Control> the following are provided.
+
+=over 4
+
+=item attrs
+
+The attribute return list.
+
+=back
+
+B<Please note:>
+
+=head1 METHODS
+
+As with L<Net::LDAP::Control> each constructor argument described above is
+also available 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.
+
+=item entry
+
+Return the L<Net::LDAP::Entry> object from the PreRead control response.
+
+=head1 SEE ALSO
+
+L<Net::LDAP>,
+L<Net::LDAP::Control>,
+
+=head1 AUTHOR
+
+Stephen Hock, based on Net::LDAP::Control::ProxyAuth from
+Graham Barr 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) 2007 Stephen Hock <[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.
+
+=cut
diff -Nur perl-ldap-0.34/lib/Net/LDAP/Control.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/Control.pm
--- perl-ldap-0.34/lib/Net/LDAP/Control.pm 2007-02-10 15:44:18.000000000
-0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/Control.pm 2007-09-10
15:04:45.000000000 -0700
@@ -18,6 +18,8 @@
LDAP_CONTROL_PERSISTENTSEARCH
LDAP_CONTROL_ENTRYCHANGE
LDAP_CONTROL_MATCHEDVALUES
+ LDAP_CONTROL_PREREAD
+ LDAP_CONTROL_POSTREAD
);
$VERSION = "0.06";
@@ -40,6 +42,8 @@
'Net::LDAP::Control::EntryChange' => LDAP_CONTROL_ENTRYCHANGE,
'Net::LDAP::Control::MatchedValues' => LDAP_CONTROL_MATCHEDVALUES,
+ 'Net::LDAP::Control::PreRead' => LDAP_CONTROL_PREREAD,
+ 'Net::LDAP::Control::PostRead' => LDAP_CONTROL_POSTREAD,
#
#LDAP_CONTROL_PWEXPIRED
#LDAP_CONTROL_PWEXPIRING
diff -Nur perl-ldap-0.34/lib/Net/LDAP/Entry.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/Entry.pm
--- perl-ldap-0.34/lib/Net/LDAP/Entry.pm 2007-02-10 15:44:18.000000000
-0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/Entry.pm 2007-09-10
14:23:41.000000000 -0700
@@ -255,6 +255,30 @@
return $self;
}
+sub increment {
+ my $self = shift;
+ my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef;
+ my $attrs = $self->{attrs} ||= _build_attrs($self);
+
+ while (my($type,$val) = splice(@_,0,2)) {
+ my $lc_type = lc $type;
+
+ push @{$self->{asn}{attributes}}, { type => $type, vals =>
($attrs->{$lc_type}=[])}
+ unless exists $attrs->{$lc_type};
+
+ push @{$attrs->{$lc_type}}, ref($val) ? @$val : $val;
+
+ push @$cmd, $type, [ ref($val) ? @$val : $val ]
+ if $cmd;
+
+ }
+
+ push(@{$self->{'changes'}}, 'increment', $cmd) if $cmd;
+
+ return $self;
+}
+
+
sub update {
my $self = shift;
diff -Nur perl-ldap-0.34/lib/Net/LDAP/LDIF.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/LDIF.pm
--- perl-ldap-0.34/lib/Net/LDAP/LDIF.pm 2007-02-10 15:44:18.000000000 -0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/LDIF.pm 2007-09-10
14:20:50.000000000 -0700
@@ -228,7 +228,7 @@
my $modattr;
my $lastattr;
if($changetype eq "modify") {
- unless ( (my $tmp = shift @ldif) =~
s/^(add|delete|replace):\s*([-;\w]+)// ) {
+ unless ( (my $tmp = shift @ldif) =~
s/^(add|delete|replace|increment):\s*([-;\w]+)// ) {
$self->_error("LDAP entry is not valid",@ldif);
return;
}
diff -Nur perl-ldap-0.34/lib/Net/LDAP/Message.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP/Message.pm
--- perl-ldap-0.34/lib/Net/LDAP/Message.pm 2007-02-10 15:44:18.000000000
-0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP/Message.pm 2007-09-10
14:15:49.000000000 -0700
@@ -212,6 +212,7 @@
##
[EMAIL PROTECTED]::LDAP::Increment::ISA = qw(Net::LDAP::Message);
@Net::LDAP::Add::ISA = qw(Net::LDAP::Message);
@Net::LDAP::Delete::ISA = qw(Net::LDAP::Message);
@Net::LDAP::Modify::ISA = qw(Net::LDAP::Message);
diff -Nur perl-ldap-0.34/lib/Net/LDAP.pm
perl-ldap-0.34+modify_increment/lib/Net/LDAP.pm
--- perl-ldap-0.34/lib/Net/LDAP.pm 2007-02-10 15:44:18.000000000 -0800
+++ perl-ldap-0.34+modify_increment/lib/Net/LDAP.pm 2007-09-10
14:16:54.000000000 -0700
@@ -496,7 +496,7 @@
}
-my %opcode = ( 'add' => 0, 'delete' => 1, 'replace' => 2);
+my %opcode = ( 'add' => 0, 'delete' => 1, 'replace' => 2, 'increment' => 3);
sub modify {
my $ldap = shift;
@@ -616,6 +616,35 @@
$ldap->_sendmesg($mesg);
}
+sub increment {
+ my $ldap = shift;
+ my $arg = &_dn_options;
+
+ my $mesg = $ldap->message('Net::LDAP::Increment' => $arg);
+
+ my $control = $arg->{control}
+ and $ldap->{net_ldap_version} < 3
+ and return _error($ldap, $mesg, LDAP_PARAM_ERROR, "Controls require
LDAPv3");
+
+ my $entry = $arg->{dn}
+ or return _error($ldap, $mesg, LDAP_PARAM_ERROR,"No DN specified");
+
+ unless (ref $entry) {
+ require Net::LDAP::Entry;
+ $entry = Net::LDAP::Entry->new;
+ $entry->dn($arg->{dn});
+ $entry->add(@{$arg->{attrs} || $arg->{attr} || []});
+ }
+
+ $mesg->encode(
+ incrementRequest => $entry->asn,
+ controls => $control
+ ) or return _error($ldap, $mesg, LDAP_ENCODING_ERROR,"$@");
+
+ $ldap->_sendmesg($mesg);
+}
+
+
sub moddn {
my $ldap = shift;
my $arg = &_dn_options;
