Menu
▾
▴
[perl-ldap-checkins] CVS: ldap/lib/Net LDAP.pm,1.47,1.48 LDAPI.pm,1.2,1.3 LDAPS.pm,1.14,1.15
|
From: Graham B. <gb...@us...> - 2003-05-09 01:25:01
|
Update of /cvsroot/perl-ldap/ldap/lib/Net
In directory sc8-pr-cvs1:/tmp/cvs-serv19753/lib/Net
Modified Files:
LDAP.pm LDAPI.pm LDAPS.pm
Log Message:
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
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pm,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -d -r1.47 -r1.48
--- LDAP.pm 7 May 2003 14:25:42 -0000 1.47
+++ LDAP.pm 8 May 2003 19:46:22 -0000 1.48
@@ -25,7 +25,7 @@
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 @@
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 @@
$obj;
}
-sub _connect {
+sub connect_ldap {
my ($ldap, $host, $arg) = @_;
$ldap->{net_ldap_socket} = IO::Socket::INET->new(
@@ -133,9 +138,88 @@
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 @@
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 @@
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, $@);
}
Index: LDAPI.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAPI.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- LDAPI.pm 7 May 2003 10:48:02 -0000 1.2
+++ LDAPI.pm 8 May 2003 19:46:23 -0000 1.3
@@ -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 @@
it and/or modify it under the same terms as Perl itself.
=cut
-
-
Index: LDAPS.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAPS.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- LDAPS.pm 7 May 2003 10:45:05 -0000 1.14
+++ LDAPS.pm 8 May 2003 19:46:23 -0000 1.15
@@ -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;
|