Permalink
Browse files

Add support for URIs to be passed to ->new. ldap: ldaps: and ldapi:

are supported.
Change Net::LDAPS and Net::LDAPI to be very thin wrappers over new URI code
Tests added for ldapi and URIs based on code from Ziya Suzen
  • Loading branch information...
1 parent 100f747 commit faf203a198cf46a266f9f725cc8917d42eb718c5 @gbarr gbarr committed May 8, 2003
Showing with 196 additions and 85 deletions.
  1. +2 −1 MANIFEST
  2. +92 −8 lib/Net/LDAP.pm
  3. +3 −13 lib/Net/LDAPI.pm
  4. +3 −54 lib/Net/LDAPS.pm
  5. +32 −0 t/56ipc.t
  6. +35 −0 t/57url.t
  7. +28 −8 t/common.pl
  8. +1 −1 test.cfg
View
@@ -52,7 +52,6 @@ lib/Net/LDAP.pod
lib/Net/LDAP/ASN.pm
lib/Net/LDAP/Bind.pm
lib/Net/LDAP/Constant.pm
-lib/Net/LDAP/Constant.pod
lib/Net/LDAP/Control.pm
lib/Net/LDAP/Control/Paged.pm
lib/Net/LDAP/Control/ProxyAuth.pm
@@ -94,6 +93,8 @@ t/52modify.t
t/53schema.t
t/54dse.t
t/55ssl.t
+t/56ipc.t
+t/57url.t
t/70sortctrl.t
t/common.pl
test.cfg
View
@@ -25,7 +25,7 @@ use Net::LDAP::Constant qw(LDAP_SUCCESS
LDAP_EXTENSION_START_TLS
);
-$VERSION = "0.2701";
+$VERSION = "0.2702";
@ISA = qw(Net::LDAP::Extra);
$LDAP_VERSION = 3; # default LDAP protocol version
@@ -99,9 +99,14 @@ sub new {
my $arg = &_options;
my $obj = bless {}, $type;
- foreach my $h (ref($host) ? @$host : ($host)) {
- if ($obj->_connect($h, $arg)) {
- $obj->{net_ldap_host} = $h;
+ foreach my $uri (ref($host) ? @$host : ($host)) {
+ my $scheme = $arg->{scheme} || 'ldap';
+ (my $h = $uri) =~ s/^(\w+):// and $scheme = $1;
+ my $meth = $obj->can("connect_$scheme") or next;
+ $h =~ s,^//([^/]*).*,$1,; # Extract host
+ $h =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/eg; # unescape
+ if (&$meth($obj, $h, $arg)) {
+ $obj->{net_ldap_uri} = $uri;
last;
}
}
@@ -122,7 +127,7 @@ sub new {
$obj;
}
-sub _connect {
+sub connect_ldap {
my ($ldap, $host, $arg) = @_;
$ldap->{net_ldap_socket} = IO::Socket::INET->new(
@@ -133,9 +138,88 @@ sub _connect {
Timeout => defined $arg->{timeout}
? $arg->{timeout}
: 120
+ ) or return undef;
+
+ $ldap->{net_ldap_host} = $host;
+}
+
+
+# Different OpenSSL verify modes.
+my %ssl_verify = qw(none 0 optional 1 require 3);
+
+sub connect_ldaps {
+ my ($ldap, $host, $arg) = @_;
+ require IO::Socket::SSL;
+
+ $ldap->{'net_ldap_socket'} = IO::Socket::SSL->new(
+ PeerAddr => $host,
+ PeerPort => $arg->{'port'} || '636',
+ Proto => 'tcp',
+ Timeout => defined $arg->{'timeout'} ? $arg->{'timeout'} : 120,
+ _SSL_context_init_args($arg)
+ ) or return undef;
+
+ $ldap->{net_ldap_host} = $host;
+}
+
+sub _SSL_context_init_args {
+ my $arg = shift;
+
+ my $verify = 0;
+ my ($clientcert,$clientkey,$passwdcb);
+
+ if (exists $arg->{'verify'}) {
+ my $v = lc $arg->{'verify'};
+ $verify = 0 + (exists $ssl_verify{$v} ? $ssl_verify{$v} : $verify);
+ }
+
+ 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 (exists $arg->{'keydecrypt'}) {
+ $passwdcb = $arg->{'keydecrypt'};
+ }
+
+ (
+ SSL_cipher_list => defined $arg->{'ciphers'} ? $arg->{'ciphers'} : 'ALL',
+ SSL_ca_file => exists $arg->{'cafile'} ? $arg->{'cafile'} : '',
+ SSL_ca_path => exists $arg->{'capath'} ? $arg->{'capath'} : '',
+ SSL_key_file => $clientcert ? $clientkey : undef,
+ SSL_passwd_cb => $passwdcb,
+ SSL_use_cert => $clientcert ? 1 : 0,
+ SSL_cert_file => $clientcert,
+ SSL_verify_mode => $verify,
+ SSL_version => defined $arg->{'sslversion'} ? $arg->{'sslversion'} :
+ 'sslv2/3',
);
}
+sub connect_ldapi {
+ my ($ldap, $peer, $arg) = @_;
+
+ $peer = $ENV{LDAPI_SOCK} || "/var/lib/ldapi"
+ unless length $peer;
+
+ require IO::Socket::UNIX;
+
+ $ldap->{net_ldap_socket} = IO::Socket::UNIX->new(
+ Peer => $peer,
+ Timeout => defined $arg->{timeout}
+ ? $arg->{timeout}
+ : 120
+ ) or return undef;
+
+ $ldap->{net_ldap_host} = 'localhost';
+ $ldap->{net_ldap_peer} = $peer;
+}
+
sub message {
my $ldap = shift;
shift->new($ldap, @_);
@@ -846,6 +930,7 @@ sub start_tls {
my $arg = &_options;
my $sock = $ldap->socket;
+ require IO::Socket::SSL;
require Net::LDAP::Extension;
my $mesg = $ldap->message('Net::LDAP::Extension' => $arg);
@@ -867,10 +952,9 @@ sub start_tls {
return $mesg
if $mesg->code;
- require Net::LDAPS;
$arg->{sslversion} = 'tlsv1' unless defined $arg->{sslversion};
- IO::Socket::SSL::context_init( { Net::LDAPS::SSL_context_init_args($arg) } );
- IO::Socket::SSL::socketToSSL($sock, {Net::LDAPS::SSL_context_init_args($arg)})
+ IO::Socket::SSL::context_init( { _SSL_context_init_args($arg) } );
+ IO::Socket::SSL::socketToSSL($sock, {_SSL_context_init_args($arg)})
? $mesg
: _error($ldap, $mesg, LDAP_OPERATIONS_ERROR, $@);
}
View
@@ -5,21 +5,13 @@
package Net::LDAPI;
@Net::LDAPI::ISA = ( 'Net::LDAP' );
-$Net::LDAPI::VERSION = "0.01";
+$Net::LDAPI::VERSION = "0.02";
use strict;
use Net::LDAP;
-use IO::Socket::UNIX;
-sub _connect {
- my ($ldap, $sockpath) = @_;
-
- $sockpath = "/var/lib/ldapi" unless defined($sockpath);
-
- $ldap->{'net_ldap_socket'} = IO::Socket::UNIX->new(
- Type => &SOCK_STREAM,
- Peer => $sockpath
- );
+sub new {
+ shift->SUPER::new(@_, scheme => 'ldapi');
}
1;
@@ -78,5 +70,3 @@ rights reserved. This library is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=cut
-
-
View
@@ -5,64 +5,13 @@
package Net::LDAPS;
@Net::LDAPS::ISA = ( 'Net::LDAP' );
-$Net::LDAPS::VERSION = "0.04";
+$Net::LDAPS::VERSION = "0.05";
use strict;
use Net::LDAP;
-use IO::Socket::SSL;
-# Different OpenSSL verify modes.
-my %verify = qw(none 0 optional 1 require 3);
-
-sub _connect {
- my ($ldap, $host, $arg) = @_;
-
- $ldap->{'net_ldap_socket'} = IO::Socket::SSL->new(
- PeerAddr => $host,
- PeerPort => $arg->{'port'} || '636',
- Proto => 'tcp',
- Timeout => defined $arg->{'timeout'} ? $arg->{'timeout'} : 120,
- SSL_context_init_args($arg)
- );
-}
-
-sub SSL_context_init_args {
- my $arg = shift;
-
- my $verify = 0;
- my ($clientcert,$clientkey,$passwdcb);
-
- if (exists $arg->{'verify'}) {
- my $v = lc $arg->{'verify'};
- $verify = 0 + (exists $verify{$v} ? $verify{$v} : $verify);
- }
-
- 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 (exists $arg->{'keydecrypt'}) {
- $passwdcb = $arg->{'keydecrypt'};
- }
-
- (
- SSL_cipher_list => defined $arg->{'ciphers'} ? $arg->{'ciphers'} : 'ALL',
- SSL_ca_file => exists $arg->{'cafile'} ? $arg->{'cafile'} : '',
- SSL_ca_path => exists $arg->{'capath'} ? $arg->{'capath'} : '',
- SSL_key_file => $clientcert ? $clientkey : undef,
- SSL_passwd_cb => $passwdcb,
- SSL_use_cert => $clientcert ? 1 : 0,
- SSL_cert_file => $clientcert,
- SSL_verify_mode => $verify,
- SSL_version => defined $arg->{'sslversion'} ? $arg->{'sslversion'} :
- 'sslv2/3',
- );
+sub new {
+ shift->SUPER::new(@_, scheme => 'ldaps');
}
1;
View
@@ -0,0 +1,32 @@
+#!perl
+
+BEGIN {
+ require "t/common.pl";
+ start_server(ipc => 1);
+}
+
+print "1..12\n";
+
+$ldap = client();
+ok($ldap, "client");
+
+$mesg = $ldap->bind($MANAGERDN, password => $PASSWD);
+
+ok(!$mesg->code, "bind: " . $mesg->code . ": " . $mesg->error);
+
+ok(ldif_populate($ldap, "data/50-in.ldif"), "data/50-in.ldif");
+
+$mesg = $ldap->search(base => $BASEDN, filter => 'objectclass=*');
+ok(!$mesg->code, "search: " . $mesg->code . ": " . $mesg->error);
+
+compare_ldif("50",$mesg,$mesg->sorted);
+
+$ldap = client(ipc => 1);
+ok($ldap, "ipc client");
+
+$mesg = $ldap->search(base => $BASEDN, filter => 'objectclass=*');
+ok(!$mesg->code, "search: " . $mesg->code . ": " . $mesg->error);
+
+compare_ldif("50",$mesg,$mesg->sorted);
+
+
View
@@ -0,0 +1,35 @@
+#!perl
+
+BEGIN {
+ require "t/common.pl";
+ start_server();
+}
+
+my $num_tests = @URL * 5 + 7;
+
+print "1..$num_tests\n";
+
+$ldap = client();
+ok($ldap, "client");
+
+$mesg = $ldap->bind($MANAGERDN, password => $PASSWD);
+
+ok(!$mesg->code, "bind: " . $mesg->code . ": " . $mesg->error);
+
+ok(ldif_populate($ldap, "data/50-in.ldif"), "data/50-in.ldif");
+
+$mesg = $ldap->search(base => $BASEDN, filter => 'objectclass=*');
+ok(!$mesg->code, "search: " . $mesg->code . ": " . $mesg->error);
+
+compare_ldif("50",$mesg,$mesg->sorted);
+
+for my $url (@URL) {
+ $ldap = client(url => $url);
+ ok($ldap, "$url client");
+
+ $mesg = $ldap->search(base => $BASEDN, filter => 'objectclass=*');
+ ok(!$mesg->code, "search: " . $mesg->code . ": " . $mesg->error);
+
+ compare_ldif("50",$mesg,$mesg->sorted);
+}
+
Oops, something went wrong.

0 comments on commit faf203a

Please sign in to comment.