/[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 19 by dpavlin, Mon Mar 16 09:46:47 2009 UTC revision 28 by dpavlin, Tue Mar 17 09:33:44 2009 UTC
# Line 20  use YAML qw/LoadFile/; Line 20  use YAML qw/LoadFile/;
20    
21  my $config = {  my $config = {
22          yaml_dir => './yaml/',          yaml_dir => './yaml/',
23          listen => 'localhost:1389',          listen => 'localhost:2389',
24          upstream_ldap => 'ldap.ffzg.hr',          upstream_ldap => 'ldap.ffzg.hr',
25          upstream_ssl => 1,          upstream_ssl => 1,
26          overlay_prefix => 'ffzg-',          overlay_prefix => 'ffzg-',
27            log_file => 'log',
28    
29  };  };
30    
31    my $log_fh;
32    
33    sub log {
34            if ( ! $log_fh ) {
35                    open($log_fh, '>>', $config->{log_file}) || die "can't open ", $config->{log_file},": $!";
36                    print $log_fh "# " . time;
37            }
38            $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  if ( ! -d $config->{yaml_dir} ) {  if ( ! -d $config->{yaml_dir} ) {
48          warn "DISABLE ", $config->{yaml_dir}," data overlay";          warn "DISABLE ", $config->{yaml_dir}," data overlay";
49  }  }
# Line 63  sub handle { Line 80  sub handle {
80  sub log_request {  sub log_request {
81          my $pdu=shift;          my $pdu=shift;
82    
83          print '-' x 80,"\n";  #       print '-' x 80,"\n";
84          print "Request ASN 1:\n";  #       print "Request ASN 1:\n";
85          Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);  #       Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
86          print "Request Perl:\n";  #       print "Request Perl:\n";
87          my $request = $LDAPRequest->decode($pdu);          my $request = $LDAPRequest->decode($pdu);
88          print dump($request);          warn "## request = ",dump($request);
89  }  }
90    
91  sub log_response {  sub log_response {
92          my $pdu=shift;          my $pdu=shift;
93    
94          print '-' x 80,"\n";  #       print '-' x 80,"\n";
95          print "Response ASN 1:\n";  #       print "Response ASN 1:\n";
96          Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);  #       Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
97          print "Response Perl:\n";  #       print "Response Perl:\n";
98          my $response = $LDAPResponse->decode($pdu);          my $response = $LDAPResponse->decode($pdu);
99    
100          if ( defined $response->{protocolOp}->{searchResEntry} ) {          if ( defined $response->{protocolOp}->{searchResEntry} ) {
# Line 108  sub log_response { Line 125  sub log_response {
125                          foreach my $type ( keys %$data ) {                          foreach my $type ( keys %$data ) {
126    
127                                  my $vals = $data->{$type};                                  my $vals = $data->{$type};
                                 $vals =~ s{#\s*$}{};  
                                   
                                 my @vals = split(/\s*#\s*/, $vals);  
128    
129                                  push @{ $response->{protocolOp}->{searchResEntry}->{attributes} },                                  push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, {
130                                          { type => $config->{overlay_prefix} . $type, vals => [ @vals ] };                                          type => $config->{overlay_prefix} . $type,
131                                            vals => ref($vals) eq 'ARRAY' ? $vals : [ $vals ],
132                                    };
133                          }                          }
134                  }                  }
135    
136                  $pdu = $LDAPResponse->encode($response);                  $pdu = $LDAPResponse->encode($response);
137          }          }
138    
139          print dump($response);          warn "## response = ", dump($response);
140    
141          return $pdu;          return $pdu;
142  }  }
# Line 154  sub run_proxy { Line 170  sub run_proxy {
170  }  }
171    
172    
173    $ENV{LANG} = 'C'; # so we don't double-encode utf-8 if LANG is utf-8
174    
175  my $listenersock = IO::Socket::INET->new(  my $listenersock = IO::Socket::INET->new(
176          Listen => 5,          Listen => 5,
177          Proto => 'tcp',          Proto => 'tcp',
Legend:
Removed from v.19  
changed lines
  Added in v.28
  ViewVC Help
Powered by ViewVC 1.1.26