/[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 22 - (hide annotations)
Mon Mar 16 10:12:57 2009 UTC (15 years ago) by dpavlin
File MIME type: text/plain
File size: 3921 byte(s)
support ARRAY values from yaml file

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 dpavlin 19 my @attrs;
88    
89 dpavlin 8 map {
90 dpavlin 19 if ( $_->{type} eq 'hrEduPersonUniqueNumber' ) {
91     foreach my $val ( @{ $_->{vals} } ) {
92     next if $val !~ m{.+:.+};
93     my ( $n, $v ) = split(/\s*:\s*/, $val );
94     push @attrs, { type => $_->{type} . '_' . $n, vals => [ $v ] };
95     }
96 dpavlin 8 }
97     } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
98    
99 dpavlin 19 warn "# ++ attrs ",dump( @attrs );
100    
101     push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, $_ foreach @attrs;
102    
103 dpavlin 18 my $path = $config->{yaml_dir} . "$uid.yaml";
104 dpavlin 10 if ( -e $path ) {
105     my $data = LoadFile($path);
106     warn "# yaml = ",dump($data);
107 dpavlin 8
108 dpavlin 10 foreach my $type ( keys %$data ) {
109    
110     my $vals = $data->{$type};
111    
112 dpavlin 22 push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, {
113     type => $config->{overlay_prefix} . $type,
114     vals => ref($vals) eq 'ARRAY' ? $vals : [ $vals ],
115     };
116 dpavlin 10 }
117     }
118    
119 dpavlin 8 $pdu = $LDAPResponse->encode($response);
120     }
121    
122 dpavlin 10 print dump($response);
123    
124 dpavlin 8 return $pdu;
125     }
126    
127     sub run_proxy {
128     my $listenersock = shift;
129     my $targetsock=shift;
130    
131     die "Could not create listener socket: $!\n" unless $listenersock;
132     die "Could not create connection to server: $!\n" unless $targetsock;
133    
134     my $sel = IO::Select->new($listenersock);
135     my %Handlers;
136     while (my @ready = $sel->can_read) {
137     foreach my $fh (@ready) {
138     if ($fh == $listenersock) {
139     # let's create a new socket
140     my $psock = $listenersock->accept;
141     $sel->add($psock);
142     } else {
143     my $result = handle($fh,$targetsock);
144     if ($result) {
145     # we have finished with the socket
146     $sel->remove($fh);
147     $fh->close;
148     delete $Handlers{*$fh};
149     }
150     }
151     }
152     }
153     }
154    
155    
156     my $listenersock = IO::Socket::INET->new(
157     Listen => 5,
158     Proto => 'tcp',
159     Reuse => 1,
160 dpavlin 18 LocalAddr => $config->{listen},
161 dpavlin 8 );
162    
163    
164 dpavlin 18 my $targetsock = $config->{upstream_ssl}
165     ? IO::Socket::INET->new(
166     Proto => 'tcp',
167     PeerAddr => $config->{upstream_ldap},
168     PeerPort => 389,
169     )
170     : IO::Socket::SSL->new( $config->{upstream_ldap} . ':ldaps')
171     ;
172 dpavlin 8
173     run_proxy($listenersock,$targetsock);
174    
175     1;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26