[prev in list] [next in list] [prev in thread] [next in thread]
List: perl-ldap-dev
Subject: FW: proxy ldap
From: "Beauchamp, Philippe" <philippe.beauchamp () emergis ! com>
Date: 2001-12-14 14:38:56
[Download RAW message or body]
[Attachment #2 (multipart/alternative)]
-----Original Message-----
From: eric german [mailto:eric.german@cp.finances.gouv.fr]
Sent: Friday, December 14, 2001 3:30
To: Beauchamp Philippe
Subject: proxy ldap
I read your message on perl ldap list . I play about proxy ldap with the
great book of Lincoln STEIN and the great Net::LDAP package . This is
my first result (one program and two package) I want add :
- Appconf
-preforking
Can you foward my message to the list ? , I can't do this from my
office
thanks a lot
eric german
[Attachment #5 (text/html)]
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<META NAME="Generator" CONTENT="MS Exchange Server version 5.5.2654.89">
<TITLE>FW: proxy ldap</TITLE>
</HEAD>
<BODY>
<BR>
<BR>
<P><FONT SIZE=2>-----Original Message-----</FONT>
<BR><FONT SIZE=2>From: eric german [<A \
HREF="mailto:eric.german@cp.finances.gouv.fr">mailto:eric.german@cp.finances.gouv.fr</A>]</FONT>
<BR><FONT SIZE=2>Sent: Friday, December 14, 2001 3:30</FONT>
<BR><FONT SIZE=2>To: Beauchamp Philippe</FONT>
<BR><FONT SIZE=2>Subject: proxy ldap</FONT>
</P>
<BR>
<P><FONT SIZE=2>I read your message on perl ldap list . I play about proxy ldap with \
the</FONT> <BR><FONT SIZE=2>great book of Lincoln STEIN and the great \
Net::LDAP package . This is</FONT> <BR><FONT SIZE=2>my first result (one \
program and two package) I want add :</FONT> <BR><FONT SIZE=2>- Appconf </FONT>
<BR><FONT SIZE=2>-preforking</FONT>
</P>
<P><FONT SIZE=2>Can you foward my message to the list ? , I can't do this from \
my</FONT> <BR><FONT SIZE=2>office </FONT>
<BR><FONT SIZE=2>thanks a lot </FONT>
<BR><FONT SIZE=2>eric german</FONT>
</P>
<P><FONT FACE="Arial" SIZE=2 COLOR="#000000"></FONT><FONT FACE="Arial" SIZE=2 \
COLOR="#000000"></FONT><FONT FACE="Arial" SIZE=2 COLOR="#000000"></FONT>
</BODY>
</HTML>
["essaisrv_session_v3.pl" (application/x-perl)]
#!/usr/bin/perl
use LogFile;
use ProxyMessage;
use IO::::Socket;
use IO::Select;
use Data::Dumper;
use Net::LDAP::ASN qw (LDAPRequest LDAPResponse);
use Net::LDAP::Filter;
use Net::LDAP::Util qw ( ldap_error_name ldap_error_text);
use Convert::ASN1 qw(asn_read);
use Fcntl;
#use Convert::ASN1;
#use strict;
init_log('/var/log/proxyldap.log') or die "erreur log $!\n";
log_priority(NOTICE);
my (%SESSIONS,%CLIENT,%counter_search); #le 1er stocke les appels serveurs
# l autre le relais client;
my $listen_socket= IO::Socket::INET->new(LocalPort => 389,
Listen =>20,
Proto =>'tcp',
Reuse => 1,
);
die $@ unless $listen_socket;
my $readers = IO::Select->new() or die "je ne peux pas creer un reader\n";
my $writers = IO::Select->new() or die "je ne peux pas creer un writers\n";
my $method;
sub do_info {
my @tmp = keys %SESSIONS;
my $nbs = $#tmp+1;
@tmp = keys %CLIENT;
my $nbc = $#tmp+1;
log_warn("nb sessions actives $nbs nb clients actifs $nbc\n" );
return;
}
sub do_pipe {
log_warn("attention session terminee\n" );
return;
}
$SIG{USR1} = \&do_info;
$SIG{PIPE} = \&do_pipe;
$readers->add($listen_socket);
log_warn("serveur lance -- ecoute du port 389\n" );
while (1) {
(my $red,my $writ,my $eout) = IO::Select->select($readers,undef,undef);
redo unless $red; # si signal detecte il faut se remettre dans la boucle
my @ready =@$red;
HANDLE:
for my $handle (@ready) {
if ($handle eq $listen_socket) { # ca arrive
my $connect = $listen_socket->accept();
###### creation du client ###########"
my $clientsocket= IO::Socket::INET->new('10.75.1.22:389')or die "je ne peux pas
connecter un client\n";
log_notice("requete detectée :client lancé\n" );
## modif pour traiter le pipe broken
my $flags ='';
fcntl ($connect,F_GETFL,$flags) or die "erreur de broklen\n";
$flags |= O_NONBLOCK ;
fcntl($connect,F_SETFL,$flags);
$SESSIONS{$connect} = $clientsocket; #on relie un serveur a un client
$CLIENT{$clientsocket} =$connect; # .. et reciproquement
$readers->add($connect);
$readers->add($clientsocket);
}
else {
#determine si le client repond ou bien serveur
if ($CLIENT{$handle}) { #c est la reponse du serveur distant
my ($buffer,$hdemandeur);
###### modif for increase the speed of fetch
my $fin =1;
my $count =0;
while ($fin==1) {
$count ++;
my $pdu ;
asn_read($handle,$pdu);
my $bytes= length $pdu;
if ($bytes >0) {
log_debug("recoit du distant $bytes \n" );
$hdemandeur = $CLIENT{$handle};
### modif pour traiter le broken pipe
my $rc = syswrite ($hdemandeur,$pdu) ;
unless ($rc) { #the requestor is going out
#I ll close safetely my connection
log_warn("requete stoppée \n" );
$readers->remove($handle) if $handle;
close $handle;
$readers->remove($hdemandeur) if $hdemandeur;
close $hdemandeur if $hdemandeur;
delete $SESSIONS{$hdemandeur} if $hdemandeur;
delete $CLIENT{$handle};
next HANDLE;
}
######### end of modif for pipebroken
my $rmessage = $LDAPResponse->decode($pdu);
my $reponse =ProxyMessage->new($rmessage);
if ($reponse->est_message()) {
$nummess =$reponse->get_num_message();
$method =$reponse->get_method();
$numerror =$reponse->get_num_error();
$erroc =$reponse->get_error();
$texer =$reponse->get_text_error();
$counter_search{$hdemandeur}{$nummess}{cp}++ if $method eq 'searchResEntry' ;
if ($method eq 'searchResDone') {
my $ligne ="recherche $counter_search{$hdemandeur}{$nummess}{filter} \
$counter_search{$hdemandeur}{$nummess}{cp} resultats \n" ; log_notice($ligne);
delete $counter_search{$hdemandeur}{$nummess};
}
log_debug("retransmet au demandeur message : $nummess $method \n" );
$meserr ="message : $nummess code :$numerror => $erroc $texer";
log_debug($meserr) if ($numerror=~ /\d+/);
}
}
if (!$bytes) { #fin de la connexion
$readers->remove($handle) if $handle;
close $handle;
$readers->remove($hdemandeur) if $hdemandeur;
close $hdemandeur if $hdemandeur;
delete $SESSIONS{$hdemandeur} if $hdemandeur;
delete $CLIENT{$handle};
$fin=0;
}
$fin=0 if $count >9;
$fin=0 if $method!~ /searchResEntry/i ;
}
next HANDLE;
} #fin reponse du serveur distant
if ($SESSIONS{$handle}) { #c est une requete sur le proxy
my $buffer;
my $bytes = sysread($handle,$buffer,2048);
if (!$bytes) { #fin de la connexion
$readers->remove($handle) if $handle;
close $handle;
my $hclient = $SESSIONS{$handle};
$readers->remove($hclient) if $hclient;
close $hclient;
delete $SESSIONS{$handle};
delete $CLIENT{$hclient};
}
if ($bytes) {
log_debug("recoit $bytes\n" ) ;
my $hclient = $SESSIONS{$handle};
syswrite $hclient,$buffer;
my $rmessage = $LDAPRequest->decode($buffer);
my $reponse =ProxyMessage->new($rmessage);
$nummess =$reponse->get_num_message();
$method =$reponse->get_method();
$suitebind =$reponse->get_bind()||$reponse->get_filtre() ;
$suitebind ="a determiner" unless $suitebind;
$counter_search{$handle}{$nummess}{filter}= $reponse->get_filtre() if
$method eq 'searchRequest' ;
log_debug("transmet au serveur $bytes octets\n");
log_notice( "transmet au serveur message : $nummess $method $suitebind\n");
undef $bytes if ($buffer =~/quit/i) ;
}
}# fin requete sur le proxy
}
} #fin du trt des handles
} #fin de la boucle infinie
["ProxyMessage.pm" (text/plain)]
package ProxyMessage;
# file: ProxyMessage.pm
$VERSION =1.00;
#use Net::LDAP;
use strict;
use Net::LDAP::Filter;
use Net::LDAP::Util qw ( ldap_error_name ldap_error_text);
sub new
{
my ($caller,$message)=@_;
my $object=ref($caller);
my $classe= $object||$caller;
my $self =bless {},$classe;
unless ($message) {
# rien a mettre retourne undef pour tout
$self->{'est_message'}=0;
return $self;
}
my ($method,@cler);
my %hmessage =%$message;
if ($hmessage{'protocolOp'}) {
my %reponse = %{$hmessage{protocolOp}};
@cler =keys %reponse; } else {
@cler = keys %hmessage; }
foreach my $item (@cler) {
if ($item=~ /Res/){ $method = $item;last;}
if ($item=~ /equest/){ $method = $item;last;}
if ($item=~ /Done$/){ $method = $item;last;}
}
$self->{'method'}=$method;
$self->{'messageID'} = $hmessage{messageID} ;
$self->{'resultCode'} =$hmessage{protocolOp}{$method}{resultCode};
$self->{'error_name'}= ldap_error_name($self->{resultCode});
$self->{'error_text'}= ldap_error_text($self->{resultCode});
$self->{'est_message'}=1;
if ($method=~ /^bind/i) {
$self->{'BindDn'} = $hmessage{$method}->{'name'} ;
}
if ($method=~ /searchrequest/i){
my $filtre= $hmessage{$method}->{filter};
my $decof = Net::LDAP::Filter::as_string($filtre);
$self->{'filtre'}= $decof;
}
return $self;
}
sub est_message {
my $self =shift;
return($self->{'est_message'});
}
sub get_method {
my $self =shift;
return($self->{'method'});
}
sub get_num_error {
my $self =shift;
return($self->{'resultCode'});
}
sub get_error {
my $self =shift;
return($self->{'error_name'});
}
sub get_text_error {
my $self =shift;
return($self->{'error_text'});
}
sub get_num_message {
my $self =shift;
return($self->{'messageID'});
}
sub get_bind {
my $self =shift;
return($self->{'BindDn'});
}
sub get_filtre {
my $self =shift;
return($self->{'filtre'});
}
1;
["LogFile.pm" (text/plain)]
package LogFile;
# file: LogFile.pm
# Figure 14.3: Logging to a File
use IO::File;
use Fcntl ':flock';
use Carp 'croak';
use strict;
use vars qw(@ISA @EXPORT);
require Exporter;
@ISA = 'Exporter';
@EXPORT = qw(DEBUG NOTICE WARNING CRITICAL
init_log log_priority
log_debug log_notice log_warn log_die);
use constant DEBUG => 0;
use constant NOTICE => 1;
use constant WARNING => 2;
use constant CRITICAL => 3;
my ($PRIORITY,$fh); # globals
sub init_log {
my $filename = shift;
$fh = IO::File->new($filename,O_WRONLY|O_APPEND|O_CREAT,0644) || return;
$fh->autoflush(1);
$PRIORITY = DEBUG; # log all
$SIG{__WARN__} = \&log_warn;
$SIG{__DIE__} = \&log_die;
return 1;
}
sub log_priority {
$PRIORITY = shift if @_;
return $PRIORITY;
}
sub _msg {
my $priority = shift;
my $time = localtime;
my $msg = join('',@_) || "Something's wrong";
my ($pack,$filename,$line) = caller(1);
$msg .= " at $filename line $line\n" unless $msg =~ /\n$/;
return "$time [$priority] $msg";
}
sub _log {
my $message = shift;
flock($fh,LOCK_EX);
print $fh $message;
flock($fh,LOCK_UN);
}
sub log_debug {
return unless DEBUG >= $PRIORITY;
_log(_msg('debug',@_));
}
sub log_notice {
return unless NOTICE >= $PRIORITY;
_log(_msg('notice',@_));
}
sub log_warn {
return unless WARNING >= $PRIORITY;
_log(_msg('warning',@_));
}
sub log_die {
return unless CRITICAL >= $PRIORITY;
_log(_msg('critical',@_));
die @_;
}
1;
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic