/[virtual-ldap]/bin/ldap-rewrite.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /bin/ldap-rewrite.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (hide annotations)
Sun Mar 15 22:00:24 2009 UTC (15 years, 1 month ago) by dpavlin
File MIME type: text/plain
File size: 3645 byte(s)
extract config into hash and display it on startup
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 dpavlin 16 use IO::Socket::SSL;
13 dpavlin 8 use warnings;
14     use Data::Dump qw/dump/;
15     use Convert::ASN1 qw(asn_read);
16     use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
17     our $VERSION = '0.2';
18     use fields qw(socket target);
19 dpavlin 10 use YAML qw/LoadFile/;
20 dpavlin 8
21 dpavlin 18 my $config = {
22     yaml_dir => './yaml/',
23     listen => 'localhost:1389',
24     upstream_ldap => 'ldap.ffzg.hr',
25     upstream_ssl => 1,
26     overlay_prefix => 'ffzg-',
27    
28     };
29    
30     if ( ! -d $config->{yaml_dir} ) {
31     warn "DISABLE ", $config->{yaml_dir}," data overlay";
32     }
33    
34     warn "# config = ",dump( $config );
35    
36 dpavlin 8 sub handle {
37     my $clientsocket=shift;
38     my $serversocket=shift;
39    
40     # read from client
41     asn_read($clientsocket, my $reqpdu);
42     log_request($reqpdu);
43    
44     return 1 unless $reqpdu;
45    
46     # send to server
47     print $serversocket $reqpdu or die "Could not send PDU to server\n ";
48    
49     # read from server
50     my $ready;
51     my $sel = IO::Select->new($serversocket);
52     for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) {
53     asn_read($serversocket, my $respdu) or return 1;
54     $respdu = log_response($respdu);
55     # and send the result to the client
56     print $clientsocket $respdu;
57     }
58    
59     return 0;
60     }
61    
62    
63     sub log_request {
64     my $pdu=shift;
65    
66     print '-' x 80,"\n";
67     print "Request ASN 1:\n";
68     Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
69     print "Request Perl:\n";
70     my $request = $LDAPRequest->decode($pdu);
71     print dump($request);
72     }
73    
74     sub log_response {
75     my $pdu=shift;
76    
77     print '-' x 80,"\n";
78     print "Response ASN 1:\n";
79     Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
80     print "Response Perl:\n";
81     my $response = $LDAPResponse->decode($pdu);
82    
83     if ( defined $response->{protocolOp}->{searchResEntry} ) {
84     my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
85     warn "## SEARCH $uid";
86 dpavlin 10
87     if(0) {
88 dpavlin 8 map {
89     if ( $_->{type} eq 'postalAddress' ) {
90     $_->{vals} = [ 'foobar' ];
91     }
92     } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
93 dpavlin 10 }
94 dpavlin 8
95 dpavlin 18 my $path = $config->{yaml_dir} . "$uid.yaml";
96 dpavlin 10 if ( -e $path ) {
97     my $data = LoadFile($path);
98     warn "# yaml = ",dump($data);
99 dpavlin 8
100 dpavlin 10 foreach my $type ( keys %$data ) {
101    
102     my $vals = $data->{$type};
103     $vals =~ s{#\s*$}{};
104    
105     my @vals = split(/\s*#\s*/, $vals);
106    
107     push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },
108 dpavlin 18 { type => $config->{overlay_prefix} . $type, vals => [ @vals ] };
109 dpavlin 10 }
110     }
111    
112 dpavlin 8 $pdu = $LDAPResponse->encode($response);
113     }
114    
115 dpavlin 10 print dump($response);
116    
117 dpavlin 8 return $pdu;
118     }
119    
120     sub run_proxy {
121     my $listenersock = shift;
122     my $targetsock=shift;
123    
124     die "Could not create listener socket: $!\n" unless $listenersock;
125     die "Could not create connection to server: $!\n" unless $targetsock;
126    
127     my $sel = IO::Select->new($listenersock);
128     my %Handlers;
129     while (my @ready = $sel->can_read) {
130     foreach my $fh (@ready) {
131     if ($fh == $listenersock) {
132     # let's create a new socket
133     my $psock = $listenersock->accept;
134     $sel->add($psock);
135     } else {
136     my $result = handle($fh,$targetsock);
137     if ($result) {
138     # we have finished with the socket
139     $sel->remove($fh);
140     $fh->close;
141     delete $Handlers{*$fh};
142     }
143     }
144     }
145     }
146     }
147    
148    
149     my $listenersock = IO::Socket::INET->new(
150     Listen => 5,
151     Proto => 'tcp',
152     Reuse => 1,
153 dpavlin 18 LocalAddr => $config->{listen},
154 dpavlin 8 );
155    
156    
157 dpavlin 18 my $targetsock = $config->{upstream_ssl}
158     ? IO::Socket::INET->new(
159     Proto => 'tcp',
160     PeerAddr => $config->{upstream_ldap},
161     PeerPort => 389,
162     )
163     : IO::Socket::SSL->new( $config->{upstream_ldap} . ':ldaps')
164     ;
165 dpavlin 8
166     run_proxy($listenersock,$targetsock);
167    
168     1;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26