X-Git-Url: http://git.rot13.org/?p=virtual-ldap;a=blobdiff_plain;f=bin%2Fldap-rewrite.pl;h=e9be738c22686ce2262dae98019afcbcd48dce8a;hp=dd781c8b91321999c814d30752c27905f72a497b;hb=72a182f851703954afd534a9e4623103b8efdab2;hpb=e2b49adaa02e6af366f1388c5556097cb08c5892 diff --git a/bin/ldap-rewrite.pl b/bin/ldap-rewrite.pl index dd781c8..e9be738 100755 --- a/bin/ldap-rewrite.pl +++ b/bin/ldap-rewrite.pl @@ -3,6 +3,12 @@ # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. +# It's modified by Dobrica Pavlinusic to include following: +# +# * rewrite LDAP bind request cn: username@domain.com -> uid=username,dc=domain,dc=com +# * rewrite search responses: +# ** expand key:value pairs from hrEduPersonUniqueNumber into hrEduPersonUniqueNumber_key +# ** augment response with yaml/dn.yaml data (for external data import) use strict; use warnings; @@ -14,23 +20,33 @@ use warnings; use Data::Dump qw/dump/; use Convert::ASN1 qw(asn_read); use Net::LDAP::ASN qw(LDAPRequest LDAPResponse); -our $VERSION = '0.2'; +our $VERSION = '0.3'; use fields qw(socket target); use YAML qw/LoadFile/; +my $debug = $ENV{DEBUG} || 0; +$|=1; # flush STDOUT + my $config = { yaml_dir => './yaml/', - listen => 'localhost:1389', + listen => shift @ARGV || 'localhost:1389', upstream_ldap => 'ldap.ffzg.hr', upstream_ssl => 1, overlay_prefix => 'ffzg-', - log_file => 'log', +# log_file => 'log/ldap-rewrite.log', }; 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 ) { open($log_fh, '>>', $config->{log_file}) || die "can't open ", $config->{log_file},": $!"; print $log_fh "# " . time; @@ -40,7 +56,7 @@ sub log { } BEGIN { - $SIG{'__WARN__'} = sub { warn @_; main::log(@_); } + $SIG{'__WARN__'} = sub { main::log(@_); } } @@ -56,9 +72,11 @@ sub handle { # read from client asn_read($clientsocket, my $reqpdu); - log_request($reqpdu); - - return 1 unless $reqpdu; + if ( ! $reqpdu ) { + warn "# client closed connection\n"; + return 0; + } + $reqpdu = log_request($reqpdu); # send to server print $serversocket $reqpdu or die "Could not send PDU to server\n "; @@ -67,29 +85,50 @@ sub handle { my $ready; my $sel = IO::Select->new($serversocket); for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) { - asn_read($serversocket, my $respdu) or return 1; + asn_read($serversocket, my $respdu); + if ( ! $respdu ) { + warn "server closed connection\n"; + return 0; + } $respdu = log_response($respdu); # and send the result to the client - print $clientsocket $respdu; + print $clientsocket $respdu || return 0; } - return 0; + return 1; } sub log_request { my $pdu=shift; + die "empty pdu" unless $pdu; + # print '-' x 80,"\n"; # 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}; + $request->{bindRequest}->{name} =~ s/[@\.]/,dc=/g; + $request->{bindRequest}->{name} =~ s/^/uid=/; + 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; + } + } + + return $pdu; } sub log_response { my $pdu=shift; + die "empty pdu" unless $pdu; # print '-' x 80,"\n"; # print "Response ASN 1:\n"; @@ -99,28 +138,61 @@ sub log_response { if ( defined $response->{protocolOp}->{searchResEntry} ) { my $uid = $response->{protocolOp}->{searchResEntry}->{objectName}; - warn "## SEARCH $uid"; + warn "# rewrite objectName $uid\n"; my @attrs; - map { - if ( $_->{type} eq 'hrEduPersonUniqueNumber' ) { - foreach my $val ( @{ $_->{vals} } ) { + foreach my $attr ( @{ $response->{protocolOp}->{searchResEntry}->{attributes} } ) { + if ( $attr->{type} =~ m/date/i ) { + 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+)$/; + } + } elsif ( $attr->{type} eq 'hrEduPersonUniqueNumber' ) { + foreach my $val ( @{ $attr->{vals} } ) { next if $val !~ m{.+:.+}; my ( $n, $v ) = split(/\s*:\s*/, $val ); - push @attrs, { type => $_->{type} . '_' . $n, vals => [ $v ] }; + 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 '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] ] }; } } - } @{ $response->{protocolOp}->{searchResEntry}->{attributes} }; + } warn "# ++ attrs ",dump( @attrs ); 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 ) { @@ -141,34 +213,6 @@ sub log_response { return $pdu; } -sub run_proxy { - my $listenersock = shift; - my $targetsock=shift; - - die "Could not create listener socket: $!\n" unless $listenersock; - die "Could not create connection to server: $!\n" unless $targetsock; - - my $sel = IO::Select->new($listenersock); - my %Handlers; - while (my @ready = $sel->can_read) { - foreach my $fh (@ready) { - if ($fh == $listenersock) { - # let's create a new socket - my $psock = $listenersock->accept; - $sel->add($psock); - } else { - my $result = handle($fh,$targetsock); - if ($result) { - # we have finished with the socket - $sel->remove($fh); - $fh->close; - delete $Handlers{*$fh}; - } - } - } - } -} - my $listenersock = IO::Socket::INET->new( Listen => 5, @@ -177,16 +221,45 @@ my $listenersock = IO::Socket::INET->new( LocalAddr => $config->{listen}, ) || die "can't open listen socket: $!"; +our $server_sock; + +sub connect_to_server { + my $sock; + if ( $config->{upstream_ssl} ) { + $sock = IO::Socket::SSL->new( $config->{upstream_ldap} . ':ldaps' ); + } else { + $sock = IO::Socket::INET->new( + Proto => 'tcp', + PeerAddr => $config->{upstream_ldap}, + PeerPort => 389, + ); + } + die "can't open ", $config->{upstream_ldap}, " $!\n" unless $sock; + warn "## connected to ", $sock->peerhost, ":", $sock->peerport, "\n"; + return $sock; +} -my $targetsock = $config->{upstream_ssl} - ? IO::Socket::INET->new( - Proto => 'tcp', - PeerAddr => $config->{upstream_ldap}, - PeerPort => 389, - ) - : IO::Socket::SSL->new( $config->{upstream_ldap} . ':ldaps') - || die "can't open upstream socket: $!"; - -run_proxy($listenersock,$targetsock); +my $sel = IO::Select->new($listenersock); +while (my @ready = $sel->can_read) { + foreach my $fh (@ready) { + if ($fh == $listenersock) { + # let's create a new socket + my $psock = $listenersock->accept; + $sel->add($psock); + warn "## add $psock " . time; + } else { + $server_sock->{$fh} ||= connect_to_server; + if ( ! handle($fh,$server_sock->{$fh}) ) { + warn "## remove $fh " . time; + $sel->remove($server_sock->{$fh}); + $server_sock->{$fh}->close; + delete $server_sock->{$fh}; + # we have finished with the socket + $sel->remove($fh); + $fh->close; + } + } + } +} 1;