/[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

Diff of /bin/ldap-rewrite.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 8 by dpavlin, Sun Mar 15 18:53:37 2009 UTC revision 16 by dpavlin, Sun Mar 15 21:20:35 2009 UTC
# Line 9  use warnings; Line 9  use warnings;
9    
10  use IO::Select;  use IO::Select;
11  use IO::Socket;  use IO::Socket;
12    use IO::Socket::SSL;
13  use warnings;  use warnings;
14  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
15  use Convert::ASN1 qw(asn_read);  use Convert::ASN1 qw(asn_read);
16  use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);  use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
17  our $VERSION = '0.2';  our $VERSION = '0.2';
18  use fields qw(socket target);  use fields qw(socket target);
19    use YAML qw/LoadFile/;
20    
21  sub handle {  sub handle {
22          my $clientsocket=shift;          my $clientsocket=shift;
# Line 62  sub log_response { Line 64  sub log_response {
64          Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);          Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
65          print "Response Perl:\n";          print "Response Perl:\n";
66          my $response = $LDAPResponse->decode($pdu);          my $response = $LDAPResponse->decode($pdu);
         print dump($response);  
67    
68          if ( defined $response->{protocolOp}->{searchResEntry} ) {          if ( defined $response->{protocolOp}->{searchResEntry} ) {
69                  my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};                  my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
70                  warn "## SEARCH $uid";                  warn "## SEARCH $uid";
71    
72    if(0) {
73                  map {                  map {
74                          if ( $_->{type} eq 'postalAddress' ) {                          if ( $_->{type} eq 'postalAddress' ) {
75                                  $_->{vals} = [ 'foobar' ];                                  $_->{vals} = [ 'foobar' ];
76                          }                          }
77                  } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };                  } @{ $response->{protocolOp}->{searchResEntry}->{attributes} };
78    }
79    
80                  push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },                  my $path = "yaml/$uid.yaml";
81                          { type => 'ffzg-datum_rodjenja', vals => [ '2009-01-01' ], }                  if ( -e $path ) {
82                  ;                          my $data = LoadFile($path);
83                            warn "# yaml = ",dump($data);
84    
85                            foreach my $type ( keys %$data ) {
86    
87                                    my $vals = $data->{$type};
88                                    $vals =~ s{#\s*$}{};
89                                    
90                                    my @vals = split(/\s*#\s*/, $vals);
91    
92                                    push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },
93                                            { type => "ffzg-$type", vals => [ @vals ] };
94                            }
95                    }
96    
97                  $pdu = $LDAPResponse->encode($response);                  $pdu = $LDAPResponse->encode($response);
98          }          }
99    
100            print dump($response);
101    
102          return $pdu;          return $pdu;
103  }  }
104    
# Line 126  my $targetsock = new IO::Socket::INET ( Line 145  my $targetsock = new IO::Socket::INET (
145          PeerPort => 389,          PeerPort => 389,
146  );  );
147    
148    $targetsock = IO::Socket::SSL->new("ldap.ffzg.hr:ldaps");
149    
150  run_proxy($listenersock,$targetsock);  run_proxy($listenersock,$targetsock);
151    
152  1;  1;
Legend:
Removed from v.8  
changed lines
  Added in v.16
  ViewVC Help
Powered by ViewVC 1.1.26