empty search response for jpegphoto without upstream ldap

[virtual-ldap] / bin / ldap-rewrite.pl

diff --git a/bin/ldap-rewrite.pl b/bin/ldap-rewrite.pl
index f7be5e3..b6f726f 100755 (executable)
--- a/bin/ldap-rewrite.pl
+++ b/bin/ldap-rewrite.pl
@@ -24,7 +24,8 @@ our $VERSION = '0.3';
 use fields qw(socket target);
 use YAML qw/LoadFile/;
 
-my $debug = 0;
+my $debug = $ENV{DEBUG} || 0;
+$|=1; # flush STDOUT
 
 my $config = {
        yaml_dir => './yaml/',
@@ -39,6 +40,11 @@ my $config = {
 my $log_fh;
 
 sub log {
+       my $level = $1 if $_[0] =~ m/^(#+)/;
+       return if defined($level) && length($level) > $debug;
+
+       warn join("\n", @_);
+
        return unless $config->{log_file};
 
        if ( ! $log_fh ) {
@@ -50,7 +56,7 @@ sub log {
 }
 
 BEGIN {
-       $SIG{'__WARN__'} = sub { warn @_; main::log(@_); }
+       $SIG{'__WARN__'} = sub { main::log(@_); }
 }
 
 
@@ -67,7 +73,7 @@ sub handle {
        # read from client
        asn_read($clientsocket, my $reqpdu);
        if ( ! $reqpdu ) {
-               warn "client closed connection\n";
+               warn "# client closed connection\n";
                return 0;
        }
        $reqpdu = log_request($reqpdu);
@@ -110,7 +116,7 @@ sub log_request {
                        my $old = $request->{bindRequest}->{name};
                        $request->{bindRequest}->{name} =~ s/[@\.]/,dc=/g;
                        $request->{bindRequest}->{name} =~ s/^/uid=/;
-                       warn "rewrite bind cn $old -> ", $request->{bindRequest}->{name};
+                       print "rewrite bind cn $old -> ", $request->{bindRequest}->{name}, "\n";
                        Convert::ASN1::asn_hexdump(\*STDOUT,$pdu) if $debug;
                        $pdu = $LDAPRequest->encode($request);
                        Convert::ASN1::asn_hexdump(\*STDOUT,$pdu) if $debug;
@@ -132,7 +138,7 @@ sub log_response {
 
        if ( defined $response->{protocolOp}->{searchResEntry} ) {
                my $uid = $response->{protocolOp}->{searchResEntry}->{objectName};
-               warn "## objectName $uid";
+               warn "# rewrite objectName $uid\n";
 
                my @attrs;
 
@@ -147,6 +153,32 @@ sub log_response {
                                        my ( $n, $v ) = split(/\s*:\s*/, $val );
                                        push @attrs, { type => $attr->{type} . '_' . $n, vals => [ $v ] };
                                }
+                       } elsif ( $attr->{type} eq 'hrEduPersonGroupMember' ) {
+                               foreach my $i ( 0 .. $#{ $attr->{vals} } ) {
+                                       $attr->{vals}->[$i] =~ s/^u2010/p2010/gs && warn "FIXME group";
+                               }
+                       } elsif ( $attr->{type} eq 'homePostalAddress' ) {
+                               foreach my $val ( @{ $attr->{vals} } ) {
+                                       next if $val !~ m{^(.+)\s*,\s*(\d+)\s+(.+)};
+                                       push @attrs,
+                                               { type => 'homePostalAddress_address', vals => [ $1 ] },
+                                               { type => 'homePostalAddress_zipcode', vals => [ $2 ] },
+                                               { type => 'homePostalAddress_city', vals => [ $3 ] };
+                               }
+                       } elsif ( $attr->{type} eq 'mail' ) {
+                               my @emails;
+                               foreach my $i ( 0 .. $#{ $attr->{vals} } ) {
+                                       my $e = $attr->{vals}->[$i];
+                                       if ( $e =~ m/\s+/ ) {
+                                               push @emails, split(/\s+/, $e);
+                                       } else {
+                                               push @emails, $e;
+                                       }
+                               }
+                               $attr->{vals} = [ shift @emails ];
+                               foreach my $i ( 0 .. $#emails ) {
+                                       push @attrs, { type => $attr->{type} . '_' . ( $i + 1 ) , vals => [ $emails[$i] ] };
+                               }
                        }
                }
 
@@ -154,10 +186,21 @@ sub log_response {
 
                push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, $_ foreach @attrs;
 
-               my $path = $config->{yaml_dir} . "$uid.yaml";
-               if ( -e $path ) {
-                       my $data = LoadFile($path);
-                       warn "# yaml = ",dump($data);
+               my @additional_yamls = ( $uid );
+               foreach my $attr ( @{ $response->{protocolOp}->{searchResEntry}->{attributes} } ) {
+                       foreach my $v ( @{ $attr->{vals} } ) {
+                               push @additional_yamls, $attr->{type} . '/' . $v;
+                       }
+               }
+
+               #warn "# additional_yamls ",dump( @additional_yamls );
+
+               foreach my $path ( @additional_yamls ) {
+                       my $full_path = $config->{yaml_dir} . '/' . $path . '.yaml';
+                       next unless -e $full_path;
+
+                       my $data = LoadFile( $full_path );
+                       warn "# $full_path yaml = ",dump($data);
 
                        foreach my $type ( keys %$data ) {