/[virtual-ldap]/lib/LDAP/Virtual.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /lib/LDAP/Virtual.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

lib/VLDAP/Server.pm revision 1 by dpavlin, Sat Mar 14 13:01:20 2009 UTC lib/LDAP/Virtual.pm revision 6 by dpavlin, Sat Mar 14 18:21:29 2009 UTC
# Line 1  Line 1 
1  package VLDAP::Server;  package LDAP::Virtual;
2    
3  use strict;  use strict;
4  use warnings;  use warnings;
# Line 14  use Net::LDAP::Filter; Line 14  use Net::LDAP::Filter;
14  use base qw(Net::LDAP::Server);  use base qw(Net::LDAP::Server);
15  use fields qw(upstream);  use fields qw(upstream);
16    
17    use Net::LDAP;
18    
19  use URI::Escape;        # uri_escape  use URI::Escape;        # uri_escape
20  use IO::Socket::INET;  use IO::Socket::INET;
21  use IO::Select;  use IO::Select;
22    
23    use YAML qw/DumpFile/;
24    
25  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
26    
27  =head1 NAME  =head1 NAME
28    
29  A3C::LDAP::Server  LDAP::Virtual
30    
31  =cut  =cut
32    
33  =head1 DESCRIPTION  =head1 DESCRIPTION
34    
35  Provide LDAP server functionality for L<A3C> somewhat similar to C<slapo-rwm>  Provide LDAP server functionality somewhat similar to C<slapo-rwm>
36    
37  =head1 METHODS  =head1 METHODS
38    
39  =head2 run  =head2 run
40    
41    my $pid = A3C::LDAP::Server->run({ port => 1389, fork => 0 });    my $pid = LDAP::Virtual->run({ port => 1389, fork => 0 });
42    
43  =cut  =cut
44    
# Line 42  our $pids; Line 46  our $pids;
46  our $cache;  our $cache;
47    
48  sub cache {  sub cache {
49          return $cache if $cache;          return $cache;
         $cache = new A3C::Cache->new({ instance => '', dir => 'ldap' });  
50  }  }
51    
52  sub run {  sub run {
# Line 80  sub run { Line 83  sub run {
83                                  # let's create a new socket                                  # let's create a new socket
84                                  my $psock = $sock->accept;                                  my $psock = $sock->accept;
85                                  $sel->add($psock);                                  $sel->add($psock);
86                                  $Handlers{*$psock} = A3C::LDAP::Server->new($psock);                                  $Handlers{*$psock} = LDAP::Virtual->new($psock);
87                          } else {                          } else {
88                                  my $result = $Handlers{*$fh}->handle;                                  my $result = $Handlers{*$fh}->handle;
89                                  if ($result) {                                  if ($result) {
# Line 96  sub run { Line 99  sub run {
99    
100  =head2 stop  =head2 stop
101    
102    my $stopped_pids = A3C::LDAP::Server->stop;    my $stopped_pids = LDAP::Virtual->stop;
103    
104  =cut  =cut
105    
# Line 141  sub bind { Line 144  sub bind {
144                  resultCode => LDAP_STRONG_AUTH_NOT_SUPPORTED,                  resultCode => LDAP_STRONG_AUTH_NOT_SUPPORTED,
145          };          };
146    
147          $self->{upstream} ||= A3C::LDAP->new->ldap or return {          $self->{upstream} ||= Net::LDAP->new( 'ldaps://ldap.ffzg.hr/' ) or return {
148                  matchedDN => '',                  matchedDN => '',
149                  errorMessage => $@,                  errorMessage => $@,
150                  resultCode => LDAP_UNAVAILABLE,                  resultCode => LDAP_UNAVAILABLE,
151          };          };
152    
153  #       warn "## upstream = ",dump( $self->{upstream} );          warn "## upstream = ",dump( $self->{upstream} );
154  #       warn "upstream not Net::LDAP but ",ref($self->{upstream}) unless ref($self->{upstream}) eq 'Net::LDAP';          warn "upstream not Net::LDAP but ",ref($self->{upstream}) unless ref($self->{upstream}) eq 'Net::LDAP';
155    
156          my $msg;          my $msg;
157    
158          # FIXME we would need to unbind because A3C::LDAP binds us automatically, but that doesn't really work          # FIXME we would need to unbind because VLDAP binds us automatically, but that doesn't really work
159          #$msg = $self->{upstream}->unbind;          #$msg = $self->{upstream}->unbind;
160          #warn "# unbind msg = ",dump( $msg );          #warn "# unbind msg = ",dump( $msg );
161    
162          $msg = $self->{upstream}->bind(          my $bind;
163                  dn => $req->{name},          $bind->{dn} = $req->{name} if $req->{name};
164                  password => $req->{authentication}->{simple}          $bind->{password} = $req->{authentication}->{simple} if $req->{authentication}->{simple};
165          );          warn "# bind ",dump( $bind );
166            $msg = $self->{upstream}->bind( %$bind );
167    
168          #warn "# bind msg = ",dump( $msg );          #warn "# bind msg = ",dump( $msg );
169          if ( $msg->code != LDAP_SUCCESS ) {          if ( $msg->code != LDAP_SUCCESS ) {
# Line 238  sub search { Line 242  sub search {
242    
243          warn "## entries = ",dump( @entries );          warn "## entries = ",dump( @entries );
244    
245          $self->cache->write_cache( \@entries, uri_escape( $filter ));  #       $self->cache->write_cache( \@entries, uri_escape( $filter ));
246    
247            my $path = uri_escape( $filter );
248            DumpFile( "var/${path}.yml", \@entries );
249            warn "# created $path ", -s $path, " bytes";
250    
251          return RESULT_OK, @entries;          return RESULT_OK, @entries;
252  }  }
Legend:
Removed from v.1  
changed lines
  Added in v.6
  ViewVC Help
Powered by ViewVC 1.1.26