empty search response for jpegphoto without upstream ldap

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

diff --git a/bin/ldap-roundcube.pl b/bin/ldap-roundcube.pl
index b6f726f..b2505e3 100755 (executable)
--- a/bin/ldap-roundcube.pl
+++ b/bin/ldap-roundcube.pl
@@ -66,6 +66,15 @@ if ( ! -d $config->{yaml_dir} ) {
 
 warn "# config = ",dump( $config );
 
+sub h2str {
+       my $str = dump(@_);
+       $str =~ s/\s//g;
+       return $str;
+}
+
+my $last_reqpdu = '';
+my $last_respdu;
+
 sub handle {
        my $clientsocket=shift;
        my $serversocket=shift;
@@ -76,11 +85,44 @@ sub handle {
                warn "# client closed connection\n";
                return 0;
        }
-       $reqpdu = log_request($reqpdu);
+
+       if ( h2str($reqpdu) eq $last_reqpdu ) {
+               warn "# cache hit";
+               print $clientsocket $last_respdu || return 0;
+               return 1;
+       }
+
+       my $request = $LDAPRequest->decode($reqpdu);
+       warn "## request = ",dump($request);
+
+       my $request_filter;
+       if (
+               exists $request->{searchRequest} &&
+               exists $request->{searchRequest}->{filter}
+       ) {
+               my $filter = dump($request->{searchRequest}->{filter});
+               $filter =~ s/\s\s+/ /gs;
+
+               warn "# FILTER $filter";
+               if ( $filter =~ m/(attributeDesc => "uid")/ ) { # mark uid serach from roundcube for new_user_identity
+                       warn "filter uid $1";
+                       $request_filter->{uid} = 1;
+               }
+               if ( $filter =~ m/(present => "jpegphoto")/ ) {
+                       warn "hard-coded response for $1";
+                       print $clientsocket $LDAPResponse->encode( {
+                               messageID  => $request->{messageID},
+                               searchResDone => { errorMessage => "", matchedDN => "", resultCode => 0 },
+                       } ) || return 0;
+                       return 1;
+               }
+       }
+
+       $reqpdu = modify_request($reqpdu, $request);
 
        # send to server
        print $serversocket $reqpdu or die "Could not send PDU to server\n ";
-       
+
        # read from server
        my $ready;
        my $sel = IO::Select->new($serversocket);
@@ -90,17 +132,25 @@ sub handle {
                        warn "server closed connection\n";
                        return 0;
                }
-               $respdu = log_response($respdu);
+
+               $respdu = modify_response($respdu, $reqpdu, $request, $request_filter);
+
+               # cache
+               $last_reqpdu = h2str($request->{searchRequest});
+               warn "# last_reqpdu $last_reqpdu";
+               $last_respdu = $respdu;
+
                # and send the result to the client
                print $clientsocket $respdu || return 0;
+
+
        }
 
        return 1;
 }
 
-
-sub log_request {
-       my $pdu=shift;
+sub modify_request {
+       my ($pdu,$request)=@_;
 
        die "empty pdu" unless $pdu;
 
@@ -108,9 +158,6 @@ sub log_request {
 #      print "Request ASN 1:\n";
 #      Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
 #      print "Request Perl:\n";
-       my $request = $LDAPRequest->decode($pdu);
-       warn "## request = ",dump($request);
-
        if ( defined $request->{bindRequest} ) {
                if ( $request->{bindRequest}->{name} =~ m{@} ) {
                        my $old = $request->{bindRequest}->{name};
@@ -126,8 +173,8 @@ sub log_request {
        return $pdu;
 }
 
-sub log_response {
-       my $pdu=shift;
+sub modify_response {
+       my ($pdu,$reqpdu,$request,$request_filter)=@_;
        die "empty pdu" unless $pdu;
 
 #      print '-' x 80,"\n";
@@ -147,6 +194,7 @@ sub log_response {
                                foreach my $i ( 0 .. $#{ $attr->{vals} } ) {
                                        $attr->{vals}->[$i] = "$1-$2-$3" if $attr->{vals}->[$i] =~ m/^([12]\d\d\d)([01]\d+)([0123]\d+)$/;
                                }
+=for disable
                        } elsif ( $attr->{type} eq 'hrEduPersonUniqueNumber' ) {
                                foreach my $val ( @{ $attr->{vals} } ) {
                                        next if $val !~ m{.+:.+};
@@ -179,6 +227,27 @@ sub log_response {
                                foreach my $i ( 0 .. $#emails ) {
                                        push @attrs, { type => $attr->{type} . '_' . ( $i + 1 ) , vals => [ $emails[$i] ] };
                                }
+=cut
+                       } 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;
+                                       }
+                               }
+                               if ( $request_filter->{uid} ) { # only for new_user_identity plugin which does uid search
+                                       $attr->{vals} = [ grep { m/\@ffzg/ } @emails ]; # remote all emails not @ffzg.hr @ffzg.unizg.hr
+                               }
+                       } elsif ( $attr->{type} eq 'facsimileTelephoneNumber' ) {
+                               my @fax;
+                               foreach my $i ( 0 .. $#{ $attr->{vals} } ) {
+                                       my $e = $attr->{vals}->[$i];
+                                       push @fax, $e;
+                               }
+                               $attr->{vals} = [ grep { ! m/\Q+385 xx xxxx xxx\E/ } @fax ];
                        }
                }
 
@@ -186,6 +255,7 @@ sub log_response {
 
                push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, $_ foreach @attrs;
 
+=for removed
                my @additional_yamls = ( $uid );
                foreach my $attr ( @{ $response->{protocolOp}->{searchResEntry}->{attributes} } ) {
                        foreach my $v ( @{ $attr->{vals} } ) {
@@ -212,6 +282,7 @@ sub log_response {
                                };
                        }
                }
+=cut
 
                $pdu = $LDAPResponse->encode($response);
        }