> > Maybe it would be reasonable to add register() functionality to
> > Net::LDAP::Search
> > (like in Net::LDAP::Control), so that one could assign
> > a custom response-message processor (decoder) for a particular
protocolOp
> > for example?
> > (IntermediateResponse with responseName = '1.3.6.1.4.1.4203.1.9.1.4' in
my
> > case)
> >
> > If you wish I can send a quick-and-dirty patch just to illustrate this
> > suggestion.
>
> Please post your patch to the list so that there is something to discuss
> about.
First ASN definition of IntermediateResponse
----------------------------------------------------------------------------
--------------------------------
diff -ru perl-ldap-0.33.orig/lib/Net/LDAP/ASN.pm
perl-ldap-0.33/lib/Net/LDAP/ASN.pm
--- perl-ldap-0.33.orig/lib/Net/LDAP/ASN.pm 2005-04-26 02:54:40.000000000
+0400
+++ perl-ldap-0.33/lib/Net/LDAP/ASN.pm 2005-10-28 14:43:36.000000000 +0400
@@ -57,7 +57,8 @@
delResponse DelResponse,
modDNResponse ModifyDNResponse,
compareResponse CompareResponse,
- extendedResp ExtendedResponse }
+ extendedResp ExtendedResponse,
+ intermediateResponse IntermediateResponse }
controls [0] Controls OPTIONAL }
MessageID ::= INTEGER -- (0 .. maxInt)
@@ -176,6 +177,11 @@
BindResponse ::= [APPLICATION 1] SEQUENCE {
COMPONENTS OF LDAPResult,
serverSaslCreds [7] OCTET STRING OPTIONAL }
+
+IntermediateResponse ::= [APPLICATION 25] SEQUENCE {
+ responseName [0] LDAPOID OPTIONAL,
+ responseValue [1] OCTET STRING OPTIONAL }
+
UnbindRequest ::= [APPLICATION 2] NULL
----------------------------------------------------------------------------
--------------------------------
Then add functionality to assign the custom decoder for a specific
protocolOp of a response message.
----------------------------------------------------------------------------
--------------------------------
diff -ru perl-ldap-0.33.orig/lib/Net/LDAP/Search.pm
perl-ldap-0.33/lib/Net/LDAP/Search.pm
--- perl-ldap-0.33.orig/lib/Net/LDAP/Search.pm 2005-04-26 02:54:38.000000000
+0400
+++ perl-ldap-0.33/lib/Net/LDAP/Search.pm 2005-11-14 13:54:12.000000000
+0300
@@ -28,17 +28,54 @@
: 0);
}
+sub protocolOp_detail {
+ my $self = shift;
+
+ return undef unless exists $self->{_protocolOp_processor};
+
+ my $protocolOp_processor = $self->{_protocolOp_processor};
+
+ my $protocolOp_detail =
$protocolOp_processor->new($self->{_protocolOp_asn});
+ return $protocolOp_detail;
+}
+
+my %Op2Pkg;
+
+sub register {
+ my $protocolOp_pkg = shift;
+ my $protocolOp = shift;
+
+ push @{$Op2Pkg{$protocolOp}}, $protocolOp_pkg;
+}
sub decode {
my $self = shift;
my $result = shift;
+ delete $self->{_protocolOp_asn};
+ delete $self->{_protocolOp_processor};
+
return $self->SUPER::decode($result)
if exists $result->{protocolOp}{searchResDone};
my $data;
@{$self}{qw(controls ctrl_hash)} = ($result->{controls}, undef);
+ if(exists $Op2Pkg{(keys %{$result->{protocolOp}})[0]}) {
+ my $protocolOp_pkgs = $Op2Pkg{(keys %{$result->{protocolOp}})[0]};
+ foreach my $protocolOp_processor (@$protocolOp_pkgs) {
+
+ if( defined($self->{_protocolOp_asn} = eval
"\$self->${protocolOp_processor}::decode(\$result)")) {
+ $self->{_protocolOp_processor} = $protocolOp_processor;
+
+ $self->{callback}->($self, undef)
+ if (defined $self->{callback});
+
+ return $self;
+ }
+ }
+ }
+
if ($data = delete $result->{protocolOp}{searchResEntry}) {
my $entry = Net::LDAP::Entry->new;
----------------------------------------------------------------------------
--------------------------------
Net::LDAP::Search::protocolOp_detail -- returns a wrapper object for
accessing custom-decoded message attributes.
Net::LDAP::Search::register -- assigns a package for decoding a response
message with a specific protocolOp value.
Net::LDAP::Search::decode calls assigned custom decoder for a response
message according to protocolOp value
Wrapper object could be used like this
(example for Sync Info IRM):
my $custom_mesg = $mesg->protocolOp_detail();
my $sync_info = $custom_mesg if defined $custom_mesg
and $custom_mesg->protocolOp() eq
'IntermediateResponse'
and $custom_mesg->type() eq
LDAP_MESSAGE_IRM_SYNCINFO;
$sync_info->newcookie() if defined $sync_info;
$sync_info->syncUUIDs() if defined $sync_info;
$sync_info->cookie() if defined $sync_info;
$sync_info->refreshDone() if defined $sync_info;
Decoder (and wrapper) for Sync Info IRM
----------------------------------------------------------------------------
--------------------------------
package Net::LDAP::Message::IRMSyncInfo;
use Net::LDAP::Search;
Net::LDAP::Search::register(__PACKAGE__, 'intermediateResponse');
use strict;
use vars qw(@ISA $VERSION);
use constant LDAP_MESSAGE_IRM_SYNCINFO => '1.3.6.1.4.1.4203.1.9.1.4';
require Exporter;
@ISA = qw(Exporter);
our @EXPORT = qw(LDAP_MESSAGE_IRM_SYNCINFO);
$VERSION = "0.01";
my $SyncInfoValue = new Convert::ASN1;
$SyncInfoValue->prepare(<<SYNC_INFO_VALUE) or die "Can't prepare
SyncInfoValue: " . $SyncInfoValue->error;
syncInfoValue ::= CHOICE {
newcookie [0] syncCookie,
refreshDelete [1] case1,
refreshPresent [2] case2,
syncIdSet [3] case3
}
case1 ::= SEQUENCE {
cookie syncCookie OPTIONAL,
refreshDone BOOLEAN OPTIONAL
}
case2 ::= SEQUENCE {
cookie syncCookie OPTIONAL,
refreshDone BOOLEAN OPTIONAL
}
case3 ::= SEQUENCE {
cookie syncCookie OPTIONAL,
refreshDeletes BOOLEAN OPTIONAL,
syncUUIDs SET OF syncUUID
}
syncUUID ::= OCTET STRING
syncCookie ::= OCTET STRING
SYNC_INFO_VALUE
sub new {
my $class = shift;
my $asn = shift;
$class = ref($class) || $class;
my $self = {asn => $asn};
return bless $self, $class;
}
sub decode {
my $self = shift;
my $result = shift;
if(exists $result->{protocolOp}{intermediateResponse}
and $result->{protocolOp}{intermediateResponse}{responseName} eq
LDAP_MESSAGE_IRM_SYNCINFO) {
my $buf = $result->{protocolOp}{intermediateResponse}{responseValue};
return $SyncInfoValue->find('syncInfoValue')->decode($buf);
}
return undef;
}
sub protocolOp {'IntermediateResponse'}
sub type {LDAP_MESSAGE_IRM_SYNCINFO}
sub sub_type {
my $self = shift;
return (keys %{$self->{asn}})[0];
}
# Make access methods for the message attributes.
for my $attr (qw(newcookie cookie refreshDone refreshDeletes syncUUIDs)) {
no strict 'refs';
*$attr = sub { my $self = shift;
return($self->{asn}{newcookie} or '')
if $attr eq 'newcookie';
my $attr_val = ${(values %{$self->{asn}})[0]}{$attr};
return $attr_val if defined $attr_val;
return '' if $attr eq 'cookie';
return undef if $attr eq 'syncUUIDs';
return $attr eq 'refreshDone' ? 1 : 0;
};
}
1;
----------------------------------------------------------------------------
--------------------------------
This package implements Sync Info IRM decoder and generates attribute-access
funcions.
All necessary detailed explanations can be sent if needed.
Best regards,
Alexey Kravchuk
