git.rot13.org Git - virtual-ldap/blob - bin/ldap-rewrite.pl

   1 #!/usr/bin/perl
   2 # Copyright (c) 2006 Hans Klunder <hans.klunder@bigfoot.com>. All rights reserved.
   3 # This program is free software; you can redistribute it and/or
   4 # modify it under the same terms as Perl itself.
   5
   6
   7 use strict;
   8 use warnings;
   9
  10 use IO::Select;
  11 use IO::Socket;
  12 use warnings;
  13 use Data::Dump qw/dump/;
  14 use Convert::ASN1 qw(asn_read);
  15 use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
  16 our $VERSION = '0.2';
  17 use fields qw(socket target);
  18
  19 sub handle {
  20         my $clientsocket=shift;
  21         my $serversocket=shift;
  22
  23         # read from client
  24         asn_read($clientsocket, my $reqpdu);
  25         log_request($reqpdu);
  26
  27         return 1 unless $reqpdu;
  28
  29         # send to server
  30         print $serversocket $reqpdu or die "Could not send PDU to server\n ";
  31
  32         # read from server
  33         my $ready;
  34         my $sel = IO::Select->new($serversocket);
  35         for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) {
  36                 asn_read($serversocket, my $respdu) or return 1;
  37                 $respdu = log_response($respdu);
  38                 # and send the result to the client
  39                 print $clientsocket $respdu;
  40         }
  41
  42         return 0;
  43 }
  44
  45
  46 sub log_request {
  47         my $pdu=shift;
  48
  49         print '-' x 80,"\n";
  50         print "Request ASN 1:\n";
  51         Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
  52         print "Request Perl:\n";
  53         my $request = $LDAPRequest->decode($pdu);
  54         print dump($request);
  55 }
  56
  57 sub log_response {
  58         my $pdu=shift;
  59
  60         print '-' x 80,"\n";
  61         print "Response ASN 1:\n";
  62         Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
  63         print "Response Perl:\n";
  64         my $response = $LDAPResponse->decode($pdu);
  65         print dump($response);
  66
  67         if ( defined $response->{protocolOp}->{searchResEntry} ) {
  68                 my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
  69                 warn "## SEARCH $uid";
  70                 map {
  71                         if ( $_->{type} eq 'postalAddress' ) {
  72                                 $_->{vals} = [ 'foobar' ];
  73                         }
  74                 } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
  75
  76                 push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },
  77                         { type => 'ffzg-datum_rodjenja', vals => [ '2009-01-01' ], }
  78                 ;
  79
  80                 $pdu = $LDAPResponse->encode($response);
  81         }
  82
  83         return $pdu;
  84 }
  85
  86 sub run_proxy {
  87         my $listenersock = shift;
  88         my $targetsock=shift;
  89
  90         die "Could not create listener socket: $!\n" unless $listenersock;
  91         die "Could not create connection to server: $!\n" unless $targetsock;
  92
  93         my $sel = IO::Select->new($listenersock);
  94         my %Handlers;
  95         while (my @ready = $sel->can_read) {
  96                 foreach my $fh (@ready) {
  97                         if ($fh == $listenersock) {
  98                                 # let's create a new socket
  99                                 my $psock = $listenersock->accept;
 100                                 $sel->add($psock);
 101                         } else {
 102                                 my $result = handle($fh,$targetsock);
 103                                 if ($result) {
 104                                         # we have finished with the socket
 105                                         $sel->remove($fh);
 106                                         $fh->close;
 107                                         delete $Handlers{*$fh};
 108                                 }
 109                         }
 110                 }
 111         }
 112 }
 113
 114
 115 my $listenersock = IO::Socket::INET->new(
 116         Listen => 5,
 117         Proto => 'tcp',
 118         Reuse => 1,
 119         LocalPort => 1389
 120 );
 121
 122
 123 my $targetsock = new IO::Socket::INET (
 124         Proto => 'tcp',
 125         PeerAddr => 'ldap.ffzg.hr',
 126         PeerPort => 389,
 127 );
 128
 129 run_proxy($listenersock,$targetsock);
 130
 131 1;