1# Copyright (c) 1998-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::Bind; 6 7use strict; 8use Net::LDAP qw(LDAP_SASL_BIND_IN_PROGRESS LDAP_DECODING_ERROR LDAP_SUCCESS 9 LDAP_LOCAL_ERROR); 10use Net::LDAP::Message; 11 12our $VERSION = '1.05'; 13our @ISA = qw(Net::LDAP::Message); 14 15sub _sasl_info { 16 my $self = shift; 17 @{$self}{qw(dn saslctrl sasl)} = @_; 18} 19 20sub decode { 21 my $self = shift; 22 my $result = shift; 23 my $bind = $result->{protocolOp}{bindResponse} 24 or $self->set_error(LDAP_DECODING_ERROR, 'LDAP decode error') 25 and return; 26 27 my $sasl = $self->{sasl}; 28 my $ldap = $self->parent; 29 30 my $resp; 31 if ($bind->{resultCode} == LDAP_SASL_BIND_IN_PROGRESS or 32 ($bind->{resultCode} == LDAP_SUCCESS and $bind->{serverSaslCreds})) { 33 $sasl or $self->set_error(LDAP_LOCAL_ERROR, 'no sasl object'), return; 34 ($resp) = $sasl->client_step($bind->{serverSaslCreds}) 35 or $self->set_error(LDAP_DECODING_ERROR, 'LDAP decode error'), return; 36 } 37 38 # Put the new layer over the raw socket, to get rid of any old layer, 39 # but only if we will be using a new layer. If we rebind but don't 40 # negotiate a new security layer, the old layer remains in place. 41 if ($sasl and $bind->{resultCode} == LDAP_SUCCESS) { 42 $sasl->property('ssf', 0) if !$sasl->property('ssf'); 43 $ldap->{net_ldap_socket} = $sasl->securesocket($ldap->{net_ldap_rawsocket}) 44 if ($sasl->property('ssf')); 45 } 46 47 return $self->SUPER::decode($result) 48 unless $bind->{resultCode} == LDAP_SASL_BIND_IN_PROGRESS; 49 50 # tell our LDAP client to forget us as this message has now completed 51 # all communications with the server 52 $ldap->_forgetmesg($self); 53 54 $self->{mesgid} = Net::LDAP::Message->NewMesgID(); # Get a new message ID 55 56 $self->encode( 57 bindRequest => { 58 version => $ldap->version, 59 name => $self->{dn}, 60 authentication => { 61 sasl => { 62 mechanism => $sasl->mechanism, 63 credentials => $resp 64 } 65 }, 66 control => $self->{saslcontrol} 67 }); 68 69 $ldap->_sendmesg($self); 70} 71 721; 73