[Summary view] [Print] [Text view]

   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  
   5  package Net::LDAP::Bind;
   6  
   7  use strict;
   8  use Net::LDAP qw(LDAP_SASL_BIND_IN_PROGRESS LDAP_DECODING_ERROR LDAP_SUCCESS
   9           LDAP_LOCAL_ERROR);
  10  use Net::LDAP::Message;
  11  use vars qw(@ISA $VERSION);
  12  
  13  $VERSION = "1.03";
  14  @ISA = qw(Net::LDAP::Message);
  15  
  16  sub _sasl_info {
  17    my $self = shift;
  18    @{$self}{qw(dn saslctrl sasl)} = @_;
  19  }
  20  
  21  sub decode {
  22    my $self = shift;
  23    my $result = shift;
  24    my $bind = $result->{protocolOp}{bindResponse}
  25       or $self->set_error(LDAP_DECODING_ERROR,"LDAP decode error")
  26      and return;
  27  
  28    my $sasl = $self->{sasl};
  29    my $ldap = $self->parent;
  30  
  31    my $resp;
  32    if ($bind->{resultCode} == LDAP_SASL_BIND_IN_PROGRESS or
  33       ($bind->{resultCode} == LDAP_SUCCESS and $bind->{serverSaslCreds})) {
  34      $sasl or $self->set_error(LDAP_LOCAL_ERROR,"no sasl object"), return;
  35      ($resp) = $sasl->client_step($bind->{serverSaslCreds})
  36        or $self->set_error(LDAP_DECODING_ERROR,"LDAP decode error"), return;
  37    }
  38  
  39    $ldap->{net_ldap_socket} = $sasl->securesocket($ldap->{net_ldap_socket})
  40      if $sasl and $bind->{resultCode} == LDAP_SUCCESS;
  41  
  42    return $self->SUPER::decode($result)
  43      unless $bind->{resultCode} == LDAP_SASL_BIND_IN_PROGRESS;
  44  
  45    # tell our LDAP client to forget us as this message has now completed
  46    # all communications with the server
  47    $ldap->_forgetmesg($self);
  48  
  49    $self->{mesgid} = Net::LDAP::Message->NewMesgID(); # Get a new message ID
  50  
  51    $self->encode(
  52      bindRequest => {
  53      version => $ldap->version,
  54      name    => $self->{dn},
  55      authentication => {
  56        sasl    => {
  57          mechanism   => $sasl->mechanism,
  58          credentials => $resp
  59        }
  60      },
  61      control => $self->{saslcontrol}
  62    });
  63  
  64    $ldap->_sendmesg($self);
  65  }
  66  
  67  1;