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