/[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 37 - (hide annotations)
Wed Mar 25 21:24:33 2009 UTC (15 years ago) by dpavlin
File MIME type: text/plain
File size: 4372 byte(s)
make listen address and port configurable as first option

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 dpavlin 37 listen => shift @ARGV || 'localhost:1389',
24 dpavlin 18 upstream_ldap => 'ldap.ffzg.hr',
25     upstream_ssl => 1,
26     overlay_prefix => 'ffzg-',
27 dpavlin 27 log_file => 'log',
28 dpavlin 18
29     };
30    
31 dpavlin 27 my $log_fh;
32    
33     sub log {
34 dpavlin 28 if ( ! $log_fh ) {
35     open($log_fh, '>>', $config->{log_file}) || die "can't open ", $config->{log_file},": $!";
36     print $log_fh "# " . time;
37     }
38 dpavlin 27 $log_fh->autoflush(1);
39     print $log_fh join("\n", @_),"\n";
40     }
41    
42     BEGIN {
43     $SIG{'__WARN__'} = sub { warn @_; main::log(@_); }
44     }
45    
46    
47 dpavlin 18 if ( ! -d $config->{yaml_dir} ) {
48     warn "DISABLE ", $config->{yaml_dir}," data overlay";
49     }
50    
51     warn "# config = ",dump( $config );
52    
53 dpavlin 8 sub handle {
54     my $clientsocket=shift;
55     my $serversocket=shift;
56    
57     # read from client
58     asn_read($clientsocket, my $reqpdu);
59     log_request($reqpdu);
60    
61     return 1 unless $reqpdu;
62    
63     # send to server
64     print $serversocket $reqpdu or die "Could not send PDU to server\n ";
65    
66     # read from server
67     my $ready;
68     my $sel = IO::Select->new($serversocket);
69     for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) {
70     asn_read($serversocket, my $respdu) or return 1;
71     $respdu = log_response($respdu);
72     # and send the result to the client
73     print $clientsocket $respdu;
74     }
75    
76     return 0;
77     }
78    
79    
80     sub log_request {
81     my $pdu=shift;
82    
83 dpavlin 28 # print '-' x 80,"\n";
84     # print "Request ASN 1:\n";
85     # Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
86     # print "Request Perl:\n";
87 dpavlin 8 my $request = $LDAPRequest->decode($pdu);
88 dpavlin 28 warn "## request = ",dump($request);
89 dpavlin 8 }
90    
91     sub log_response {
92     my $pdu=shift;
93    
94 dpavlin 28 # print '-' x 80,"\n";
95     # print "Response ASN 1:\n";
96     # Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
97     # print "Response Perl:\n";
98 dpavlin 8 my $response = $LDAPResponse->decode($pdu);
99    
100     if ( defined $response->{protocolOp}->{searchResEntry} ) {
101     my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
102 dpavlin 37 warn "## objectName $uid";
103 dpavlin 10
104 dpavlin 19 my @attrs;
105    
106 dpavlin 8 map {
107 dpavlin 19 if ( $_->{type} eq 'hrEduPersonUniqueNumber' ) {
108     foreach my $val ( @{ $_->{vals} } ) {
109     next if $val !~ m{.+:.+};
110     my ( $n, $v ) = split(/\s*:\s*/, $val );
111     push @attrs, { type => $_->{type} . '_' . $n, vals => [ $v ] };
112     }
113 dpavlin 8 }
114     } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
115    
116 dpavlin 19 warn "# ++ attrs ",dump( @attrs );
117    
118     push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, $_ foreach @attrs;
119    
120 dpavlin 18 my $path = $config->{yaml_dir} . "$uid.yaml";
121 dpavlin 10 if ( -e $path ) {
122     my $data = LoadFile($path);
123     warn "# yaml = ",dump($data);
124 dpavlin 8
125 dpavlin 10 foreach my $type ( keys %$data ) {
126    
127     my $vals = $data->{$type};
128    
129 dpavlin 22 push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, {
130     type => $config->{overlay_prefix} . $type,
131     vals => ref($vals) eq 'ARRAY' ? $vals : [ $vals ],
132     };
133 dpavlin 10 }
134     }
135    
136 dpavlin 8 $pdu = $LDAPResponse->encode($response);
137     }
138    
139 dpavlin 28 warn "## response = ", dump($response);
140 dpavlin 10
141 dpavlin 8 return $pdu;
142     }
143    
144     sub run_proxy {
145     my $listenersock = shift;
146     my $targetsock=shift;
147    
148     die "Could not create listener socket: $!\n" unless $listenersock;
149     die "Could not create connection to server: $!\n" unless $targetsock;
150    
151     my $sel = IO::Select->new($listenersock);
152     my %Handlers;
153     while (my @ready = $sel->can_read) {
154     foreach my $fh (@ready) {
155     if ($fh == $listenersock) {
156     # let's create a new socket
157     my $psock = $listenersock->accept;
158     $sel->add($psock);
159     } else {
160     my $result = handle($fh,$targetsock);
161     if ($result) {
162     # we have finished with the socket
163     $sel->remove($fh);
164     $fh->close;
165     delete $Handlers{*$fh};
166     }
167     }
168     }
169     }
170     }
171    
172    
173     my $listenersock = IO::Socket::INET->new(
174     Listen => 5,
175     Proto => 'tcp',
176     Reuse => 1,
177 dpavlin 18 LocalAddr => $config->{listen},
178 dpavlin 29 ) || die "can't open listen socket: $!";
179 dpavlin 8
180    
181 dpavlin 18 my $targetsock = $config->{upstream_ssl}
182     ? IO::Socket::INET->new(
183     Proto => 'tcp',
184     PeerAddr => $config->{upstream_ldap},
185     PeerPort => 389,
186     )
187     : IO::Socket::SSL->new( $config->{upstream_ldap} . ':ldaps')
188 dpavlin 29 || die "can't open upstream socket: $!";
189 dpavlin 8
190     run_proxy($listenersock,$targetsock);
191    
192     1;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26