1# Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4
5package Net::LDAP::Message;
6
7use Net::LDAP::Constant qw(LDAP_SUCCESS LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE);
8use Net::LDAP::ASN qw(LDAPRequest);
9use strict;
10
11our $VERSION = '1.12';
12
13my $MsgID = 0;
14
15# We do this here so when we add threading we can lock it
16sub NewMesgID {
17  $MsgID = 1  if ++$MsgID > 65535;
18  $MsgID;
19}
20
21sub new {
22  my $self   = shift;
23  my $type   = ref($self) || $self;
24  my $parent = shift->inner;
25  my $arg    = shift;
26
27  $self = bless {
28    parent   => $parent,
29    mesgid   => NewMesgID(),
30    callback => $arg->{callback} || undef,
31    raw      => $arg->{raw} || undef,
32  }, $type;
33
34  $self;
35}
36
37sub code {
38  my $self = shift;
39
40  $self->sync  unless exists $self->{resultCode};
41
42  exists $self->{resultCode}
43    ? $self->{resultCode}
44    : undef
45}
46
47sub done {
48  my $self = shift;
49
50  exists $self->{resultCode};
51}
52
53sub dn {
54  my $self = shift;
55
56  $self->sync  unless exists $self->{resultCode};
57
58  exists $self->{matchedDN}
59    ? $self->{matchedDN}
60    : undef
61}
62
63sub referrals {
64  my $self = shift;
65
66  $self->sync  unless exists $self->{resultCode};
67
68  exists $self->{referral}
69    ? @{$self->{referral}}
70    : ();
71}
72
73sub server_error {
74  my $self = shift;
75
76  $self->sync  unless exists $self->{resultCode};
77
78  exists $self->{errorMessage}
79    ? $self->{errorMessage}
80    : undef
81}
82
83sub error {
84  my $self = shift;
85  my $return;
86
87  unless ($return = $self->server_error) {
88    require Net::LDAP::Util and
89    $return = Net::LDAP::Util::ldap_error_desc( $self->code );
90  }
91
92  $return;
93}
94
95sub set_error {
96  my $self = shift;
97  ($self->{resultCode}, $self->{errorMessage}) = ($_[0]+0, "$_[1]");
98  $self->{callback}->($self)
99    if (defined $self->{callback});
100  $self;
101}
102
103sub error_name {
104  require Net::LDAP::Util;
105  Net::LDAP::Util::ldap_error_name(shift->code);
106}
107
108sub error_text {
109  require Net::LDAP::Util;
110  Net::LDAP::Util::ldap_error_text(shift->code);
111}
112
113sub error_desc {
114  require Net::LDAP::Util;
115  Net::LDAP::Util::ldap_error_desc(shift->code);
116}
117
118sub sync {
119  my $self = shift;
120  my $ldap = $self->{parent};
121  my $err;
122
123  until(exists $self->{resultCode}) {
124    $err = $ldap->sync($self->mesg_id)  or next;
125    $self->set_error($err, 'Protocol Error')
126      unless exists $self->{resultCode};
127    return $err;
128  }
129
130  LDAP_SUCCESS;
131}
132
133
134sub decode { # $self, $pdu, $control
135  my $self = shift;
136  my $result = shift;
137  my $data = (values %{$result->{protocolOp}})[0];
138
139  @{$self}{keys %$data} = values %$data;
140
141  @{$self}{qw(controls ctrl_hash)} = ($result->{controls}, undef);
142
143  # free up memory as we have a result so we will not need to re-send it
144  delete $self->{pdu};
145
146  if ($data = delete $result->{protocolOp}{intermediateResponse}) {
147
148    my $intermediate = Net::LDAP::Intermediate->from_asn($data);
149
150    if (defined $self->{callback}) {
151      $self->{callback}->($self, $intermediate);
152    } else {
153      push(@{$self->{intermediate} ||= []}, $intermediate);
154    }
155
156    return $self;
157  } else {
158    # tell our LDAP client to forget us as this message has now completed
159    # all communications with the server
160    $self->parent->_forgetmesg($self);
161  }
162
163  $self->{callback}->($self)
164    if (defined $self->{callback});
165
166  $self;
167}
168
169
170sub abandon {
171  my $self = shift;
172
173  return  if exists $self->{resultCode}; # already complete
174
175  my $ldap = $self->{parent};
176
177  $ldap->abandon($self->{mesgid});
178}
179
180sub saslref {
181  my $self = shift;
182
183  $self->sync  unless exists $self->{resultCode};
184
185  exists $self->{sasl}
186    ? $self->{sasl}
187    : undef
188}
189
190
191sub encode {
192  my $self = shift;
193
194  $self->{pdu} = $LDAPRequest->encode(@_, messageID => $self->{mesgid})
195    or return;
196  1;
197}
198
199sub control {
200  my $self = shift;
201
202  if ($self->{controls}) {
203    require Net::LDAP::Control;
204    my $hash = $self->{ctrl_hash} = {};
205    foreach my $asn (@{delete $self->{controls}}) {
206      my $ctrl = Net::LDAP::Control->from_asn($asn);
207      $ctrl->{raw} = $self->{parent}->{raw}
208        if ($self->{parent});
209      push @{$hash->{$ctrl->type} ||= []}, $ctrl;
210    }
211  }
212
213  my $ctrl_hash = $self->{ctrl_hash}
214    or return;
215
216  my @oid = @_ ? @_ : keys %$ctrl_hash;
217  my @control = map {@$_} grep $_, @{$ctrl_hash}{@oid}
218    or return;
219
220  # return a list, so in a scalar context we do not just get array length
221  return @control[0 .. $#control];
222}
223
224sub pdu      {  shift->{pdu}      }
225sub callback {  shift->{callback} }
226sub parent   {  shift->{parent}->outer   }
227sub mesg_id  {  shift->{mesgid}   }
228sub is_error {  shift->code       }
229
230##
231##
232##
233
234
235@Net::LDAP::Add::ISA     = qw(Net::LDAP::Message);
236@Net::LDAP::Delete::ISA  = qw(Net::LDAP::Message);
237@Net::LDAP::Modify::ISA  = qw(Net::LDAP::Message);
238@Net::LDAP::ModDN::ISA   = qw(Net::LDAP::Message);
239@Net::LDAP::Compare::ISA = qw(Net::LDAP::Message);
240@Net::LDAP::Unbind::ISA  = qw(Net::LDAP::Message::Dummy);
241@Net::LDAP::Abandon::ISA = qw(Net::LDAP::Message::Dummy);
242
243sub Net::LDAP::Compare::is_error {
244  my $mesg = shift;
245  my $code = $mesg->code;
246  $code != LDAP_COMPARE_FALSE and $code != LDAP_COMPARE_TRUE
247}
248
249{
250  package Net::LDAP::Message::Dummy;
251  our @ISA = qw(Net::LDAP::Message);
252  use Net::LDAP::Constant qw(LDAP_SUCCESS);
253
254  sub new {
255    my $self   = shift;
256    my $type   = ref($self) || $self;
257
258    $self = bless {
259      mesgid   => Net::LDAP::Message::NewMesgID(),
260    }, $type;
261
262    $self;
263  }
264
265  sub sync    { shift }
266  sub decode  { shift }
267  sub abandon { shift }
268  sub code { shift->{resultCode} || LDAP_SUCCESS }
269  sub error { shift->{errorMessage} || '' }
270  sub dn { '' }
271  sub done { 1 }
272}
273
2741;
275