virtual-ldap/bin/ldap-rewrite.pl

#!/usr/bin/perl
# Copyright (c) 2006 Hans Klunder <hans.klunder@bigfoot.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.


use strict;
use warnings;

use IO::Select;
use IO::Socket;
use warnings;
use Data::Dump qw/dump/;
use Convert::ASN1 qw(asn_read);
use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
our $VERSION = '0.2';
use fields qw(socket target);
use YAML qw/LoadFile/;

sub handle {
        my $clientsocket=shift;
        my $serversocket=shift;

        # read from client
        asn_read($clientsocket, my $reqpdu);
        log_request($reqpdu);

        return 1 unless $reqpdu;

        # send to server
        print $serversocket $reqpdu or die "Could not send PDU to server\n ";
        
        # read from server
        my $ready;
        my $sel = IO::Select->new($serversocket);
        for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) {
                asn_read($serversocket, my $respdu) or return 1;
                $respdu = log_response($respdu);
                # and send the result to the client
                print $clientsocket $respdu;
        }

        return 0;
}


sub log_request {
        my $pdu=shift;

        print '-' x 80,"\n";
        print "Request ASN 1:\n";
        Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
        print "Request Perl:\n";
        my $request = $LDAPRequest->decode($pdu);
        print dump($request);
}

sub log_response {
        my $pdu=shift;

        print '-' x 80,"\n";
        print "Response ASN 1:\n";
        Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
        print "Response Perl:\n";
        my $response = $LDAPResponse->decode($pdu);

        if ( defined $response->{protocolOp}->{searchResEntry} ) {
                my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
                warn "## SEARCH $uid";

if(0) {
                map {
                        if ( $_->{type} eq 'postalAddress' ) {
                                $_->{vals} = [ 'foobar' ];
                        }
                } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
}

                my $path = "yaml/$uid.yaml";
                if ( -e $path ) {
                        my $data = LoadFile($path);
                        warn "# yaml = ",dump($data);

                        foreach my $type ( keys %$data ) {

                                my $vals = $data->{$type};
                                $vals =~ s{#\s*$}{};
                                
                                my @vals = split(/\s*#\s*/, $vals);

                                push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },
                                        { type => "ffzg-$type", vals => [ @vals ] };
                        }
                }

                $pdu = $LDAPResponse->encode($response);
        }

        print dump($response);

        return $pdu;
}

sub run_proxy {
        my $listenersock = shift;
        my $targetsock=shift;

        die "Could not create listener socket: $!\n" unless $listenersock;
        die "Could not create connection to server: $!\n" unless $targetsock;

        my $sel = IO::Select->new($listenersock);
        my %Handlers;
        while (my @ready = $sel->can_read) {
                foreach my $fh (@ready) {
                        if ($fh == $listenersock) {
                                # let's create a new socket
                                my $psock = $listenersock->accept;
                                $sel->add($psock);
                        } else {
                                my $result = handle($fh,$targetsock);
                                if ($result) {
                                        # we have finished with the socket
                                        $sel->remove($fh);
                                        $fh->close;
                                        delete $Handlers{*$fh};
                                }
                        }
                }
        }
}


my $listenersock = IO::Socket::INET->new(
        Listen => 5,
        Proto => 'tcp',
        Reuse => 1,
        LocalPort => 1389
);


my $targetsock = new IO::Socket::INET (
        Proto => 'tcp',
        PeerAddr => 'ldap.ffzg.hr',
        PeerPort => 389,
);

run_proxy($listenersock,$targetsock);

1;
1	dpavlin	8	#!/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	dpavlin	10	use YAML qw/LoadFile/;
19	dpavlin	8
20			sub handle {
21			my $clientsocket=shift;
22			my $serversocket=shift;
23
24			# read from client
25			asn_read($clientsocket, my $reqpdu);
26			log_request($reqpdu);
27
28			return 1 unless $reqpdu;
29
30			# send to server
31			print $serversocket $reqpdu or die "Could not send PDU to server\n ";
32
33			# read from server
34			my $ready;
35			my $sel = IO::Select->new($serversocket);
36			for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) {
37			asn_read($serversocket, my $respdu) or return 1;
38			$respdu = log_response($respdu);
39			# and send the result to the client
40			print $clientsocket $respdu;
41			}
42
43			return 0;
44			}
45
46
47			sub log_request {
48			my $pdu=shift;
49
50			print '-' x 80,"\n";
51			print "Request ASN 1:\n";
52			Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
53			print "Request Perl:\n";
54			my $request = $LDAPRequest->decode($pdu);
55			print dump($request);
56			}
57
58			sub log_response {
59			my $pdu=shift;
60
61			print '-' x 80,"\n";
62			print "Response ASN 1:\n";
63			Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
64			print "Response Perl:\n";
65			my $response = $LDAPResponse->decode($pdu);
66
67			if ( defined $response->{protocolOp}->{searchResEntry} ) {
68			my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
69			warn "## SEARCH $uid";
70	dpavlin	10
71			if(0) {
72	dpavlin	8	map {
73			if ( $_->{type} eq 'postalAddress' ) {
74			$_->{vals} = [ 'foobar' ];
75			}
76			} @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
77	dpavlin	10	}
78	dpavlin	8
79	dpavlin	10	my $path = "yaml/$uid.yaml";
80			if ( -e $path ) {
81			my $data = LoadFile($path);
82			warn "# yaml = ",dump($data);
83	dpavlin	8
84	dpavlin	10	foreach my $type ( keys %$data ) {
85
86			my $vals = $data->{$type};
87			$vals =~ s{#\s*$}{};
88
89			my @vals = split(/\s#\s/, $vals);
90
91			push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },
92			{ type => "ffzg-$type", vals => [ @vals ] };
93			}
94			}
95
96	dpavlin	8	$pdu = $LDAPResponse->encode($response);
97			}
98
99	dpavlin	10	print dump($response);
100
101	dpavlin	8	return $pdu;
102			}
103
104			sub run_proxy {
105			my $listenersock = shift;
106			my $targetsock=shift;
107
108			die "Could not create listener socket: $!\n" unless $listenersock;
109			die "Could not create connection to server: $!\n" unless $targetsock;
110
111			my $sel = IO::Select->new($listenersock);
112			my %Handlers;
113			while (my @ready = $sel->can_read) {
114			foreach my $fh (@ready) {
115			if ($fh == $listenersock) {
116			# let's create a new socket
117			my $psock = $listenersock->accept;
118			$sel->add($psock);
119			} else {
120			my $result = handle($fh,$targetsock);
121			if ($result) {
122			# we have finished with the socket
123			$sel->remove($fh);
124			$fh->close;
125			delete $Handlers{*$fh};
126			}
127			}
128			}
129			}
130			}
131
132
133			my $listenersock = IO::Socket::INET->new(
134			Listen => 5,
135			Proto => 'tcp',
136			Reuse => 1,
137			LocalPort => 1389
138			);
139
140
141			my $targetsock = new IO::Socket::INET (
142			Proto => 'tcp',
143			PeerAddr => 'ldap.ffzg.hr',
144			PeerPort => 389,
145			);
146
147			run_proxy($listenersock,$targetsock);
148
149			1;