--- bin/ldap-rewrite.pl 2009/03/15 22:00:24 18 +++ bin/ldap-rewrite.pl 2009/03/17 09:33:44 28 @@ -20,13 +20,30 @@ my $config = { yaml_dir => './yaml/', - listen => 'localhost:1389', + listen => 'localhost:2389', upstream_ldap => 'ldap.ffzg.hr', upstream_ssl => 1, overlay_prefix => 'ffzg-', + log_file => 'log', }; +my $log_fh; + +sub log { + if ( ! $log_fh ) { + open($log_fh, '>>', $config->{log_file}) || die "can't open ", $config->{log_file},": $!"; + print $log_fh "# " . time; + } + $log_fh->autoflush(1); + print $log_fh join("\n", @_),"\n"; +} + +BEGIN { + $SIG{'__WARN__'} = sub { warn @_; main::log(@_); } +} + + if ( ! -d $config->{yaml_dir} ) { warn "DISABLE ", $config->{yaml_dir}," data overlay"; } @@ -63,34 +80,42 @@ sub log_request { my $pdu=shift; - print '-' x 80,"\n"; - print "Request ASN 1:\n"; - Convert::ASN1::asn_hexdump(\*STDOUT,$pdu); - print "Request Perl:\n"; +# print '-' x 80,"\n"; +# print "Request ASN 1:\n"; +# Convert::ASN1::asn_hexdump(\*STDOUT,$pdu); +# print "Request Perl:\n"; my $request = $LDAPRequest->decode($pdu); - print dump($request); + warn "## request = ",dump($request); } sub log_response { my $pdu=shift; - print '-' x 80,"\n"; - print "Response ASN 1:\n"; - Convert::ASN1::asn_hexdump(\*STDOUT,$pdu); - print "Response Perl:\n"; +# print '-' x 80,"\n"; +# print "Response ASN 1:\n"; +# Convert::ASN1::asn_hexdump(\*STDOUT,$pdu); +# print "Response Perl:\n"; my $response = $LDAPResponse->decode($pdu); if ( defined $response->{protocolOp}->{searchResEntry} ) { my $uid = $response->{protocolOp}->{searchResEntry}->{objectName}; warn "## SEARCH $uid"; -if(0) { + my @attrs; + map { - if ( $_->{type} eq 'postalAddress' ) { - $_->{vals} = [ 'foobar' ]; + if ( $_->{type} eq 'hrEduPersonUniqueNumber' ) { + foreach my $val ( @{ $_->{vals} } ) { + next if $val !~ m{.+:.+}; + my ( $n, $v ) = split(/\s*:\s*/, $val ); + push @attrs, { type => $_->{type} . '_' . $n, vals => [ $v ] }; + } } } @{ $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 ) { @@ -100,19 +125,18 @@ foreach my $type ( keys %$data ) { my $vals = $data->{$type}; - $vals =~ s{#\s*$}{}; - - my @vals = split(/\s*#\s*/, $vals); - push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, - { type => $config->{overlay_prefix} . $type, vals => [ @vals ] }; + push @{ $response->{protocolOp}->{searchResEntry}->{attributes} }, { + type => $config->{overlay_prefix} . $type, + vals => ref($vals) eq 'ARRAY' ? $vals : [ $vals ], + }; } } $pdu = $LDAPResponse->encode($response); } - print dump($response); + warn "## response = ", dump($response); return $pdu; } @@ -146,6 +170,8 @@ } +$ENV{LANG} = 'C'; # so we don't double-encode utf-8 if LANG is utf-8 + my $listenersock = IO::Socket::INET->new( Listen => 5, Proto => 'tcp',