[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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 5 package Net::LDAP::Message; 6 7 use Net::LDAP::Constant qw(LDAP_SUCCESS LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE); 8 use Net::LDAP::ASN qw(LDAPRequest); 9 use strict; 10 use vars qw($VERSION); 11 12 $VERSION = "1.11"; 13 14 my $MsgID = 0; 15 16 # We do this here so when we add threading we can lock it 17 sub NewMesgID { 18 $MsgID = 1 if ++$MsgID > 65535; 19 $MsgID; 20 } 21 22 sub new { 23 my $self = shift; 24 my $type = ref($self) || $self; 25 my $parent = shift->inner; 26 my $arg = shift; 27 28 $self = bless { 29 parent => $parent, 30 mesgid => NewMesgID(), 31 callback => $arg->{callback} || undef, 32 raw => $arg->{raw} || undef, 33 }, $type; 34 35 $self; 36 } 37 38 sub code { 39 my $self = shift; 40 41 $self->sync unless exists $self->{resultCode}; 42 43 exists $self->{resultCode} 44 ? $self->{resultCode} 45 : undef 46 } 47 48 sub done { 49 my $self = shift; 50 51 exists $self->{resultCode}; 52 } 53 54 sub dn { 55 my $self = shift; 56 57 $self->sync unless exists $self->{resultCode}; 58 59 exists $self->{matchedDN} 60 ? $self->{matchedDN} 61 : undef 62 } 63 64 sub referrals { 65 my $self = shift; 66 67 $self->sync unless exists $self->{resultCode}; 68 69 exists $self->{referral} 70 ? @{$self->{referral}} 71 : (); 72 } 73 74 sub server_error { 75 my $self = shift; 76 77 $self->sync unless exists $self->{resultCode}; 78 79 exists $self->{errorMessage} 80 ? $self->{errorMessage} 81 : undef 82 } 83 84 sub error { 85 my $self = shift; 86 my $return; 87 88 unless ($return = $self->server_error) { 89 require Net::LDAP::Util and 90 $return = Net::LDAP::Util::ldap_error_desc( $self->code ); 91 } 92 93 $return; 94 } 95 96 sub set_error { 97 my $self = shift; 98 ($self->{resultCode},$self->{errorMessage}) = ($_[0]+0, "$_[1]"); 99 $self->{callback}->($self) 100 if (defined $self->{callback}); 101 $self; 102 } 103 104 sub error_name { 105 require Net::LDAP::Util; 106 Net::LDAP::Util::ldap_error_name(shift->code); 107 } 108 109 sub error_text { 110 require Net::LDAP::Util; 111 Net::LDAP::Util::ldap_error_text(shift->code); 112 } 113 114 sub error_desc { 115 require Net::LDAP::Util; 116 Net::LDAP::Util::ldap_error_desc(shift->code); 117 } 118 119 sub sync { 120 my $self = shift; 121 my $ldap = $self->{parent}; 122 my $err; 123 124 until(exists $self->{resultCode}) { 125 $err = $ldap->sync($self->mesg_id) or next; 126 $self->set_error($err,"Protocol Error") 127 unless exists $self->{resultCode}; 128 return $err; 129 } 130 131 LDAP_SUCCESS; 132 } 133 134 135 sub decode { # $self, $pdu, $control 136 my $self = shift; 137 my $result = shift; 138 my $data = (values %{$result->{protocolOp}})[0]; 139 140 @{$self}{keys %$data} = values %$data; 141 142 @{$self}{qw(controls ctrl_hash)} = ($result->{controls}, undef); 143 144 # free up memory as we have a result so we will not need to re-send it 145 delete $self->{pdu}; 146 147 if ($data = delete $result->{protocolOp}{intermediateResponse}) { 148 149 my $intermediate = Net::LDAP::Intermediate->from_asn($data); 150 151 push(@{$self->{'intermediate'} ||= []}, $intermediate); 152 153 $self->{callback}->($self, $intermediate) 154 if (defined $self->{callback}); 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 170 sub 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 180 sub 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 191 sub encode { 192 my $self = shift; 193 194 $self->{pdu} = $LDAPRequest->encode(@_, messageID => $self->{mesgid}) 195 or return; 196 1; 197 } 198 199 sub 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 return unless $self->{ctrl_hash}; 214 215 @_ ? exists $self->{ctrl_hash}{$_[0]} 216 ? @{$self->{ctrl_hash}{$_[0]}} 217 : () 218 : map { @$_ } values %{$self->{ctrl_hash}}; 219 } 220 221 sub pdu { shift->{pdu} } 222 sub callback { shift->{callback} } 223 sub parent { shift->{parent}->outer } 224 sub mesg_id { shift->{mesgid} } 225 sub is_error { shift->code } 226 227 ## 228 ## 229 ## 230 231 232 @Net::LDAP::Add::ISA = qw(Net::LDAP::Message); 233 @Net::LDAP::Delete::ISA = qw(Net::LDAP::Message); 234 @Net::LDAP::Modify::ISA = qw(Net::LDAP::Message); 235 @Net::LDAP::ModDN::ISA = qw(Net::LDAP::Message); 236 @Net::LDAP::Compare::ISA = qw(Net::LDAP::Message); 237 @Net::LDAP::Unbind::ISA = qw(Net::LDAP::Message::Dummy); 238 @Net::LDAP::Abandon::ISA = qw(Net::LDAP::Message::Dummy); 239 240 sub Net::LDAP::Compare::is_error { 241 my $mesg = shift; 242 my $code = $mesg->code; 243 $code != LDAP_COMPARE_FALSE and $code != LDAP_COMPARE_TRUE 244 } 245 246 { 247 package Net::LDAP::Message::Dummy; 248 use vars qw(@ISA); 249 @ISA = qw(Net::LDAP::Message); 250 251 sub sync { shift } 252 sub decode { shift } 253 sub abandon { shift } 254 sub code { 0 } 255 sub error { "" } 256 sub dn { "" } 257 sub done { 1 } 258 } 259 260 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |