From: Dobrica Pavlinusic Date: Sat, 14 Mar 2009 13:01:20 +0000 (+0000) Subject: extract virtual LDAP part from A3C X-Git-Url: http://git.rot13.org/?p=virtual-ldap;a=commitdiff_plain;h=29fe303d9bbf96111a33d300d9f9754159a9ac0d extract virtual LDAP part from A3C --- 29fe303d9bbf96111a33d300d9f9754159a9ac0d diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..57202c4 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,14 @@ +use inc::Module::Install; + +name 'VLDAP'; +version '0.00'; +license 'GPL'; + +requires 'Net::LDAP::Server'; +requires 'URI::Escape'; +requires 'IO::Socket::INET'; +requires 'Data::Dump'; + +auto_install; + +WriteAll; diff --git a/bin/virtual-ldap.pl b/bin/virtual-ldap.pl new file mode 100755 index 0000000..d7dc738 --- /dev/null +++ b/bin/virtual-ldap.pl @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib 'lib'; +use VLDAP::Server; + +VLDAP::Server->run({ port => 1389 }); + +1; diff --git a/lib/VLDAP/Server.pm b/lib/VLDAP/Server.pm new file mode 100644 index 0000000..56094ba --- /dev/null +++ b/lib/VLDAP/Server.pm @@ -0,0 +1,248 @@ +package VLDAP::Server; + +use strict; +use warnings; + +use Net::LDAP::Constant qw( + LDAP_SUCCESS + LDAP_STRONG_AUTH_NOT_SUPPORTED + LDAP_UNAVAILABLE + LDAP_OPERATIONS_ERROR +); +use Net::LDAP::Server; +use Net::LDAP::Filter; +use base qw(Net::LDAP::Server); +use fields qw(upstream); + +use URI::Escape; # uri_escape +use IO::Socket::INET; +use IO::Select; + +use Data::Dump qw/dump/; + +=head1 NAME + +A3C::LDAP::Server + +=cut + +=head1 DESCRIPTION + +Provide LDAP server functionality for L somewhat similar to C + +=head1 METHODS + +=head2 run + + my $pid = A3C::LDAP::Server->run({ port => 1389, fork => 0 }); + +=cut + +our $pids; +our $cache; + +sub cache { + return $cache if $cache; + $cache = new A3C::Cache->new({ instance => '', dir => 'ldap' }); +} + +sub run { + my $self = shift; + + my $args = shift; + # default LDAP port + my $port = $args->{port} ||= 1389; + + if ( $args->{fork} ) { + defined(my $pid = fork()) or die "Can't fork: $!"; + if ( $pid ) { + $pids->{ $port } = $pid; + warn "# pids = ",dump( $pids ); + sleep 1; + return $pid; + } + } + + my $sock = IO::Socket::INET->new( + Listen => 5, + Proto => 'tcp', + Reuse => 1, + LocalPort => $port, + ) or die "can't listen on port $port: $!\n"; + + warn "LDAP server listening on port $port\n"; + + my $sel = IO::Select->new($sock) or die "can't select socket: $!\n"; + my %Handlers; + while (my @ready = $sel->can_read) { + foreach my $fh (@ready) { + if ($fh == $sock) { + # let's create a new socket + my $psock = $sock->accept; + $sel->add($psock); + $Handlers{*$psock} = A3C::LDAP::Server->new($psock); + } else { + my $result = $Handlers{*$fh}->handle; + if ($result) { + # we have finished with the socket + $sel->remove($fh); + $fh->close; + delete $Handlers{*$fh}; + } + } + } + } +} + +=head2 stop + + my $stopped_pids = A3C::LDAP::Server->stop; + +=cut + +sub stop { + warn "## stop pids = ",dump( $pids ); + return unless $pids; + my $stopped = 0; + foreach my $port ( keys %$pids ) { + my $pid = delete($pids->{$port}) or die "no pid?"; + warn "# Shutdown LDAP server at port $port pid $pid\n"; + kill(9,$pid) or die "can't kill $pid: $!"; + waitpid($pid,0) or die "waitpid $pid: $!"; + $stopped++; + } + warn "## stopped $stopped processes\n"; + return $stopped; +} + +use constant RESULT_OK => { + 'matchedDN' => '', + 'errorMessage' => '', + 'resultCode' => LDAP_SUCCESS +}; + +# constructor +sub new { + my ($class, $sock) = @_; + my $self = $class->SUPER::new($sock); + printf "Accepted connection from: %s\n", $sock->peerhost(); + return $self; +} + +# the bind operation +sub bind { + my ($self,$req) = @_; + + warn "## bind req = ",dump($req); + + defined($req->{authentication}->{simple}) or return { + matchedDN => '', + errorMessage => '', + resultCode => LDAP_STRONG_AUTH_NOT_SUPPORTED, + }; + + $self->{upstream} ||= A3C::LDAP->new->ldap or return { + matchedDN => '', + errorMessage => $@, + resultCode => LDAP_UNAVAILABLE, + }; + +# warn "## upstream = ",dump( $self->{upstream} ); +# warn "upstream not Net::LDAP but ",ref($self->{upstream}) unless ref($self->{upstream}) eq 'Net::LDAP'; + + my $msg; + + # FIXME we would need to unbind because A3C::LDAP binds us automatically, but that doesn't really work + #$msg = $self->{upstream}->unbind; + #warn "# unbind msg = ",dump( $msg ); + + $msg = $self->{upstream}->bind( + dn => $req->{name}, + password => $req->{authentication}->{simple} + ); + + #warn "# bind msg = ",dump( $msg ); + if ( $msg->code != LDAP_SUCCESS ) { + warn "ERROR: ", $msg->code, ": ", $msg->server_error, "\n"; + return { + matchedDN => '', + errorMessage => $msg->server_error, + resultCode => $msg->code, + }; + } + + return RESULT_OK; +} + +# the search operation +sub search { + my ($self,$req) = @_; + + warn "## search req = ",dump( $req ); + + if ( ! $self->{upstream} ) { + warn "search without bind"; + return { + matchedDN => '', + errorMessage => 'dude, bind first', + resultCode => LDAP_OPERATIONS_ERROR, + }; + } + + my $filter; + if (defined $req->{filter}) { + # $req->{filter} is a ASN1-decoded tree; luckily, this is exactly the + # internal representation Net::LDAP::Filter uses. [FIXME] Eventually + # Net::LDAP::Filter should provide a corresponding constructor. + bless($req->{filter}, 'Net::LDAP::Filter'); + $filter = $req->{filter}->as_string; +# $filter = '(&' . $req->{filter}->as_string +# . '(objectClass=hrEduPerson)(host=aai.irb.hr))'; + } + + warn "search upstream for $filter\n"; + + my $search = $self->{upstream}->search( + base => $req->{baseObject}, + scope => $req->{scope}, + deref => $req->{derefAliases}, + sizelimit => $req->{sizeLimit}, + timelimit => $req->{timeLimit}, + typesonly => $req->{typesOnly}, + filter => $filter, + attrs => $req->{attributes}, + raw => qr/.*/, + ); + +# warn "# search = ",dump( $search ); + + if ( $search->code != LDAP_SUCCESS ) { + warn "ERROR: ",$search->code,": ",$search->server_error; + return { + matchedDN => '', + errorMessage => $search->server_error, + resultCode => $search->code, + }; + }; + + my @entries = $search->entries; + warn "## got ", $search->count, " entries for $filter\n"; + foreach my $entry (@entries) { +# $entry->changetype('add'); # Don't record changes. +# foreach my $attr ($entry->attributes) { +# if ($attr =~ /;lang-en$/) { +# $entry->delete($attr); +# } +# } + } + + warn "## entries = ",dump( @entries ); + + $self->cache->write_cache( \@entries, uri_escape( $filter )); + + return RESULT_OK, @entries; +} + +# the rest of the operations will return an "unwilling to perform" + +1;