CVS: ispman/lib/Net LDAP.pm,1.3,1.4 XWhois.pm,1.2,1.3 Daemon.pm,1.1,NONE Server.pm,1.1,NONE
Joerg Delker <[email protected]>
| Newsgroups | gmane.comp.isp.ispman.cvs |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/ispman/ispman/lib/Net
In directory sc8-pr-cvs1:/tmp/cvs-serv23200/lib/Net
Modified Files:
LDAP.pm XWhois.pm
Removed Files:
Daemon.pm Server.pm
Log Message:
rollback of HEAD to REL_1_0 versions
former HEAD development will continue in "experimental-branch" and merged back here
(more info on ispman-developer maillist and upcoming README.cvs in HEAD)
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/ispman/ispman/lib/Net/LDAP.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** LDAP.pm 29 Jul 2003 12:47:05 -0000 1.3
--- LDAP.pm 4 Jan 2004 18:56:15 -0000 1.4
***************
*** 8,12 ****
use IO::Socket;
use IO::Select;
- use Tie::Hash;
use vars qw($VERSION $LDAP_VERSION @ISA);
use Convert::ASN1 qw(asn_read);
--- 8,11 ----
***************
*** 22,34 ****
LDAP_PARAM_ERROR
LDAP_INAPPROPRIATE_AUTH
- LDAP_SERVER_DOWN
- LDAP_USER_CANCELED
- LDAP_EXTENSION_START_TLS
- LDAP_UNAVAILABLE
);
! $VERSION = "0.29";
! @ISA = qw(Tie::StdHash Net::LDAP::Extra);
! $LDAP_VERSION = 3; # default LDAP protocol version
# Net::LDAP::Extra will only exist is someone use's the module. But we need
--- 21,29 ----
LDAP_PARAM_ERROR
LDAP_INAPPROPRIATE_AUTH
);
! $VERSION = 0.25;
! @ISA = qw(Net::LDAP::Extra);
! $LDAP_VERSION = 2; # default LDAP protocol version
# Net::LDAP::Extra will only exist is someone use's the module. But we need
***************
*** 102,119 ****
my $obj = bless {}, $type;
! 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,/.*,,; # remove path part
! $h =~ s/%([A-Fa-f0-9]{2})/chr(hex($1))/eg; # unescape
! if (&$meth($obj, $h, $arg)) {
! $obj->{net_ldap_uri} = $uri;
! last;
! }
! }
!
! return undef unless $obj->{net_ldap_socket};
$obj->{net_ldap_resp} = {};
$obj->{net_ldap_version} = $arg->{version} || $LDAP_VERSION;
--- 97,103 ----
my $obj = bless {}, $type;
! $obj->_connect($host, $arg) or return;
+ $obj->{net_ldap_host} = $host;
$obj->{net_ldap_resp} = {};
$obj->{net_ldap_version} = $arg->{version} || $LDAP_VERSION;
***************
*** 127,224 ****
$obj->debug($arg->{debug} || 0 );
! $obj->outer;
}
! sub connect_ldap {
my ($ldap, $host, $arg) = @_;
$ldap->{net_ldap_socket} = IO::Socket::INET->new(
! PeerAddr => $host,
! PeerPort => $arg->{port} || '389',
! Proto => 'tcp',
! MultiHomed => $arg->{multihomed},
! 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;
}
--- 111,128 ----
$obj->debug($arg->{debug} || 0 );
! $obj;
}
! sub _connect {
my ($ldap, $host, $arg) = @_;
$ldap->{net_ldap_socket} = IO::Socket::INET->new(
! PeerAddr => $host,
! PeerPort => $arg->{port} || '389',
! Proto => 'tcp',
Timeout => defined $arg->{timeout}
? $arg->{timeout}
: 120
! );
}
***************
*** 330,356 ****
my $sasl = $passwd;
# Tell the SASL object our user identifier
! $sasl->callback( user => "dn: $stash{name}")
! unless $sasl->callback('user');
!
! my $sasl_conn = $sasl->client_new("ldap",$ldap->{net_ldap_host});
!
! # Tell SASL the local and server IP addresses
! $sasl_conn->property(
! sockname => $ldap->{net_ldap_socket}->sockname,
! peername => $ldap->{net_ldap_socket}->peername,
! );
!
! my $initial = $sasl_conn->client_start;
!
! return _error($ldap, $mesg, LDAP_LOCAL_ERROR, "$@")
! unless defined($initial);
$passwd = {
! mechanism => $sasl_conn->mechanism,
! credentials => (length($initial) ? $initial : undef)
};
# Save data, we will need it later
! $mesg->_sasl_info($stash{name},$control,$sasl_conn);
}
--- 234,246 ----
my $sasl = $passwd;
# Tell the SASL object our user identifier
! $sasl->user("dn: $dn") unless $sasl->user;
$passwd = {
! mechanism => $sasl->name,
! credentials => $sasl->initial
};
# Save data, we will need it later
! $mesg->_sasl_info($stash{name},$control,$sasl);
}
***************
*** 521,525 ****
modification => {
type => $attr,
! vals => ref($val) ? $val : [$val]
}
};
--- 411,415 ----
modification => {
type => $attr,
! vals => $val
}
};
***************
*** 677,681 ****
$mesg->encode(
! extendedReq => {
requestName => $arg->{name},
requestValue => $arg->{value}
--- 567,571 ----
$mesg->encode(
! extendedRequest => {
requestName => $arg->{name},
requestValue => $arg->{value}
***************
*** 701,709 ****
}
- sub disconnect {
- my $self = shift;
- _drop_conn($self, LDAP_USER_CANCELED, "Explicit disconnect");
- }
-
sub _sendmesg {
my $ldap = shift;
--- 591,594 ----
***************
*** 722,728 ****
}
! my $socket = $ldap->socket or return LDAP_SERVER_DOWN;
!
! syswrite($socket, $mesg->pdu, length($mesg->pdu))
or return _error($ldap, $mesg, LDAP_LOCAL_ERROR,"$!");
--- 607,611 ----
}
! syswrite($ldap->socket, $mesg->pdu, length($mesg->pdu))
or return _error($ldap, $mesg, LDAP_LOCAL_ERROR,"$!");
***************
*** 751,755 ****
my $ldap = shift;
my $what = shift;
! my $sock = $ldap->socket or return LDAP_SERVER_DOWN;
my $sel = IO::Select->new($sock);
my $ready;
--- 634,638 ----
my $ldap = shift;
my $what = shift;
! my $sock = $ldap->socket;
my $sel = IO::Select->new($sock);
my $ready;
***************
*** 758,762 ****
my $pdu;
asn_read($sock, $pdu)
! or return _drop_conn($ldap, LDAP_OPERATIONS_ERROR, "Communications Error");
my $debug;
--- 641,645 ----
my $pdu;
asn_read($sock, $pdu)
! or return LDAP_OPERATIONS_ERROR;
my $debug;
***************
*** 775,792 ****
or return LDAP_DECODING_ERROR;
! my $mid = $result->{messageID};
! my $mesg = $ldap->{net_ldap_mesg}->{$mid};
!
! unless ($mesg) {
! if (my $ext = $result->{protocolOp}{extendedResp}) {
! if (($ext->{responseName} || '') eq '1.3.6.1.4.1.1466.20036') {
! # notice of disconnection
! return _drop_conn($ldap, LDAP_SERVER_DOWN, "Notice of Disconnection");
! }
! }
! print STDERR "Unexpected PDU, ignored\n" if $debug & 10;
! next;
! }
$mesg->decode($result) or
--- 658,668 ----
or return LDAP_DECODING_ERROR;
! my $mid = $result->{messageID};
! my $mesg = $ldap->{net_ldap_mesg}->{$mid} or
! do {
! print STDERR "Unexpected PDU, ignored\n" if $debug & 10;
! next;
! };
$mesg->decode($result) or
***************
*** 802,821 ****
}
- sub _drop_conn {
- my ($self, $err, $etxt) = @_;
-
- my $sock = delete $self->{net_ldap_socket};
- close($sock) if $sock;
-
- if (my $msgs = delete $self->{net_ldap_mesg}) {
- foreach my $mesg (values %$msgs) {
- $mesg->set_error($err, $etxt);
- }
- }
-
- $err;
- }
-
-
sub _forgetmesg {
my $ldap = shift;
--- 678,681 ----
***************
*** 879,883 ****
}
-
sub root_dse {
my $ldap = shift;
--- 739,742 ----
***************
*** 892,898 ****
supportedLDAPVersion
)];
- my $root = $arg{attrs} && $ldap->{net_ldap_root_dse};
-
- return $root if $root;
my $mesg = $ldap->search(
--- 751,754 ----
***************
*** 903,913 ****
);
! require Net::LDAP::RootDSE;
! $root = $mesg->entry;
! bless $root, 'Net::LDAP::RootDSE' if $root; # Naughty, but there you go :-)
!
! $ldap->{net_ldap_root_dse} = $root unless $arg{attrs};
!
! return $root;
}
--- 759,763 ----
);
! $mesg->entry;
}
***************
*** 917,921 ****
my $sock = $ldap->socket;
- require IO::Socket::SSL;
require Net::LDAP::Extension;
my $mesg = $ldap->message('Net::LDAP::Extension' => $arg);
--- 767,770 ----
***************
*** 929,933 ****
$mesg->encode(
extendedReq => {
! requestName => LDAP_EXTENSION_START_TLS,
}
);
--- 778,782 ----
$mesg->encode(
extendedReq => {
! requestName => "1.3.6.1.4.1.1466.20037",
}
);
***************
*** 939,959 ****
if $mesg->code;
! delete $ldap->{net_ldap_root_dse};
!
$arg->{sslversion} = 'tlsv1' unless defined $arg->{sslversion};
! IO::Socket::SSL::context_init( { _SSL_context_init_args($arg) } );
! my $sock_class = ref($sock);
!
! return $mesg
! if IO::Socket::SSL::socketToSSL($sock, {_SSL_context_init_args($arg)});
!
! my $err = $@;
!
! if ($sock_class ne ref($sock)) {
! $err = $sock->errstr;
! bless $sock, $sock_class;
! }
!
! _error($ldap, $mesg, LDAP_OPERATIONS_ERROR, $err);
}
--- 788,797 ----
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) and tie *{$sock}, 'IO::Socket::SSL', $sock)
! ? $mesg
! : _error($ldap, $mesg, LDAP_OPERATIONS_ERROR, $@);
}
***************
*** 979,1006 ****
? ($ldap->{net_ldap_version},$ldap->{net_ldap_version} = shift)[0]
: $ldap->{net_ldap_version};
- }
-
- sub outer {
- my $self = shift;
- return $self if tied(%$self);
- my %outer;
- tie %outer, ref($self), $self;
- ++$self->{net_ldap_refcnt};
- bless \%outer, ref($self);
- }
-
- sub inner {
- tied(%{$_[0]}) || $_[0];
- }
-
- sub TIEHASH {
- $_[1];
- }
-
- sub DESTROY {
- my $ldap = shift;
- my $inner = tied(%$ldap) or return;
- _drop_conn($inner, LDAP_UNAVAILABLE, "Implicit disconnect")
- unless --$inner->{net_ldap_refcnt};
}
--- 817,820 ----
Index: XWhois.pm
===================================================================
RCS file: /cvsroot/ispman/ispman/lib/Net/XWhois.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
--- Daemon.pm DELETED ---
--- Server.pm DELETED ---
-------------------------------------------------------
This SF.net email is sponsored by: IBM Linux Tutorials.
Become an expert in LINUX or just sharpen your skills. Sign up for IBM's
Free Linux Tutorials. Learn everything from the bash shell to sys admin.
Click now! http://ads.osdn.com/?ad_id=1278&alloc_id=3371&op=click