[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;