view release on metacpan or  search on metacpan

lib/Net/LDAP.pm  view on Meta::CPAN

  undef => sub { require Carp; Carp::carp(_err_msg(@_))  if $^W; undef },
);

sub _error {
  my ($ldap, $mesg) = splice(@_, 0, 2);

  $mesg->set_error(@_);
  $ldap->{net_ldap_onerror} && !$ldap->{net_ldap_async}
    ? scalar &{$ldap->{net_ldap_onerror}}($mesg)
    : $mesg;
}

sub new {
  my $self = shift;
  my $type = ref($self) || $self;
  my $host = shift  if @_ % 2;
  my $arg  = &_options;
  my $obj  = bless {}, $type;

  foreach my $uri (ref($host) ? @$host : ($host)) {
    my $scheme = $arg->{scheme} || 'ldap';
    my $h = $uri;
    if (defined($h)) {
      $h =~ s,^(\w+)://,, and $scheme = lc($1);
      $h =~ s,/.*,,; # remove path part
      $h =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/eg; # unescape
    }
    my $meth = $obj->can("connect_$scheme")  or next;
    if (&$meth($obj, $h, $arg)) {
      $obj->{net_ldap_uri} = $uri;
      $obj->{net_ldap_scheme} = $scheme;
      last;
    }
  }

  return undef  unless $obj->{net_ldap_socket};

  $obj->{net_ldap_socket}->setsockopt(SOL_SOCKET, SO_KEEPALIVE, $arg->{keepalive} ? 1 : 0)
    if (defined($arg->{keepalive}));

  $obj->{net_ldap_rawsocket} = $obj->{net_ldap_socket};
  $obj->{net_ldap_resp}    = {};
  $obj->{net_ldap_version} = $arg->{version} || $LDAP_VERSION;
  $obj->{net_ldap_async}   = $arg->{async} ? 1 : 0;
  $obj->{raw} = $arg->{raw}  if ($arg->{raw});

  if (defined(my $onerr = $arg->{onerror})) {
    $onerr = $onerror{$onerr}  if exists $onerror{$onerr};
    $obj->{net_ldap_onerror} = $onerr;
  }

  $obj->debug($arg->{debug} || 0 );

  $obj->outer;
}

sub connect_ldap {
  my ($ldap, $host, $arg) = @_;
  my $port = $arg->{port} || 389;
  my $class = (CAN_IPV6) ? CAN_IPV6 : 'IO::Socket::INET';
  my $domain = $arg->{inet4} ? AF_INET : ($arg->{inet6} ? AF_INET6 : AF_UNSPEC);

  # separate port from host overwriting given/default port
  $host =~ s/^([^:]+|\[.*\]):(\d+)$/$1/ and $port = $2;

  if ($arg->{inet6} && !CAN_IPV6) {
    $@ = 'unable to load IO::Socket::INET6; no IPv6 support';
    return undef;
  }

  $ldap->{net_ldap_socket} = $class->new(
    PeerAddr   => $host,
    PeerPort   => $port,
    LocalAddr  => $arg->{localaddr} || undef,
    Proto      => 'tcp',
    ($class eq 'IO::Socket::IP' ? 'Family' : 'Domain')     => $domain,
    MultiHomed => $arg->{multihomed},
    Timeout    => defined $arg->{timeout}
		 ? $arg->{timeout}
		 : 120
  ) or return undef;

  $ldap->{net_ldap_host} = $host;
  $ldap->{net_ldap_port} = $port;
}


# Different OpenSSL verify modes.
my %ssl_verify = qw(none 0 optional 1 require 3);

sub connect_ldaps {
  my ($ldap, $host, $arg) = @_;
  my $port = $arg->{port} || 636;
  my $domain = $arg->{inet4} ? AF_INET : ($arg->{inet6} ? AF_INET6 : AF_UNSPEC);

  if ($arg->{inet6} && !CAN_IPV6) {
    $@ = 'unable to load IO::Socket::INET6; no IPv6 support';
    return undef;
  }

  require IO::Socket::SSL;

  # separate port from host overwriting given/default port
  $host =~ s/^([^:]+|\[.*\]):(\d+)$/$1/ and $port = $2;

  $ldap->{net_ldap_socket} = IO::Socket::SSL->new(
    PeerAddr 	    => $host,
    PeerPort 	    => $port,
    LocalAddr       => $arg->{localaddr} || undef,
    Proto    	    => 'tcp',
    Domain          => $domain,
    Timeout  	    => defined $arg->{timeout} ? $arg->{timeout} : 120,
    _SSL_context_init_args({sslserver => $host, %$arg})
  ) or return undef;

  $ldap->{net_ldap_host} = $host;
  $ldap->{net_ldap_port} = $port;
}

sub _SSL_context_init_args {
  my $arg = shift;

  my $verify = 0;
  my %verifycn_ctx = ();
  my ($clientcert, $clientkey, $passwdcb);

  if (exists $arg->{verify}) {
      my $v = lc $arg->{verify};
      $verify = 0 + (exists $ssl_verify{$v} ? $ssl_verify{$v} : $verify);

      if ($verify) {
        $verifycn_ctx{SSL_verifycn_scheme} = 'ldap';
        $verifycn_ctx{SSL_verifycn_name} = $arg->{sslserver}
          if (defined $arg->{sslserver});
      }
  }

  if (exists $arg->{clientcert}) {
      $clientcert = $arg->{clientcert};
      if (exists $arg->{clientkey}) {
	  $clientkey = $arg->{clientkey};
      } else {
	  require Carp;
	  Carp::croak('Setting client public key but not client private key');
      }
  }

  if ($arg->{checkcrl} && !$arg->{capath}) {
      require Carp;
      Carp::croak('Cannot check CRL without having CA certificates');
  }

  if (exists $arg->{keydecrypt}) {
      $passwdcb = $arg->{keydecrypt};
  }