/[A3C]/lib/A3C/LDAP/Server.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/A3C/LDAP/Server.pm

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

revision 222 by dpavlin, Thu Jun 26 20:46:33 2008 UTC revision 223 by dpavlin, Thu Jun 26 21:57:33 2008 UTC
# Line 2  package A3C::LDAP::Server; Line 2  package A3C::LDAP::Server;
2    
3  use strict;  use strict;
4  use warnings;  use warnings;
 use Data::Dumper;  
5    
6  use lib '../lib';  use Net::LDAP::Constant qw(
7  use Net::LDAP::Constant qw(LDAP_SUCCESS);          LDAP_SUCCESS
8            LDAP_STRONG_AUTH_NOT_SUPPORTED
9            LDAP_UNAVAILABLE
10            LDAP_OPERATIONS_ERROR
11    );
12  use Net::LDAP::Server;  use Net::LDAP::Server;
13    use Net::LDAP::Filter;
14  use base 'Net::LDAP::Server';  use base 'Net::LDAP::Server';
15  use fields qw();  use fields qw(upstream);
16    
17    use A3C::LDAP;
18    use Data::Dump qw/dump/;
19    
20  use constant RESULT_OK => {  use constant RESULT_OK => {
21          'matchedDN' => '',          'matchedDN' => '',
# Line 26  sub new { Line 33  sub new {
33    
34  # the bind operation  # the bind operation
35  sub bind {  sub bind {
36          my $self = shift;          my ($self,$req) = @_;
37          my $reqData = shift;  
38          print Dumper($reqData);          warn "## bind req = ",dump($req);
39    
40            defined($req->{authentication}->{simple}) or return {
41                    matchedDN => '',
42                    errorMessage => '',
43                    resultCode => LDAP_STRONG_AUTH_NOT_SUPPORTED,
44            };
45    
46            $self->{upstream} ||= A3C::LDAP->new->ldap or return {
47                    matchedDN => '',
48                    errorMessage => $@,
49                    resultCode => LDAP_UNAVAILABLE,
50            };
51    
52            warn "## upstream = ",dump( $self->{upstream} );
53    #       warn "upstream not Net::LDAP but ",ref($self->{upstream}) unless ref($self->{upstream}) eq 'Net::LDAP';
54    
55          return RESULT_OK;          return RESULT_OK;
56  }  }
57    
58  # the search operation  # the search operation
59  sub search {  sub search {
60          my $self = shift;          my ($self,$req) = @_;
61          my $reqData = shift;  
62          print "Searching...\n";          warn "## search req = ",dump( $req );
         print Dumper($reqData);  
         my $base = $reqData->{'baseObject'};  
           
         my @entries;  
         if ($reqData->{'scope'}) {  
63    
64            if ( ! $self->{upstream} ) {
65                    warn "search without bind";
66                    return {
67                            matchedDN => '',
68                            errorMessage => 'dude, bind first',
69                            resultCode => LDAP_OPERATIONS_ERROR,
70                    };
71          }          }
72          warn ">> ",Dumper( @entries );  
73            my $filter;
74            if (defined $req->{filter}) {
75                    # $req->{filter} is a ASN1-decoded tree; luckily, this is exactly the
76                    # internal representation Net::LDAP::Filter uses.  [FIXME] Eventually
77                    # Net::LDAP::Filter should provide a corresponding constructor.
78                    bless($req->{filter}, 'Net::LDAP::Filter');
79                    $filter = $req->{filter}->as_string;
80    #               $filter = '(&' . $req->{filter}->as_string
81    #                                          . '(objectClass=hrEduPerson)(host=aai.irb.hr))';
82            }
83    
84            warn "search upstream for $filter";
85    
86            my $search = $self->{upstream}->search(
87                    base => $req->{baseObject},
88                    scope => $req->{scope},
89                    deref => $req->{derefAliases},
90                    sizelimit => $req->{sizeLimit},
91                    timelimit => $req->{timeLimit},
92                    typesonly => $req->{typesOnly},
93                    filter => $filter,
94                    attrs => $req->{attributes},
95                    raw => qr/.*/,
96            );
97    
98            warn "# search = ",dump( $search );
99    
100            if ( $search->code != LDAP_SUCCESS ) {
101                    warn "ERROR: ",$search->code,": ",$search->server_error;
102                    return {
103                            matchedDN => '',
104                            errorMessage => $search->server_error,
105                            resultCode => $search->code,
106                    };
107            };
108    
109            my @entries = $search->entries;
110            warn "## got ", $search->count, " entries for ", $filter;
111            foreach my $entry (@entries) {
112                    $entry->changetype('add');  # Don't record changes.
113    #               foreach my $attr ($entry->attributes) {
114    #                       if ($attr =~ /;lang-en$/) {
115    #                               $entry->delete($attr);
116    #                       }
117    #               }
118            }
119    
120            warn "## entries = ",dump( @entries );
121          return RESULT_OK, @entries;          return RESULT_OK, @entries;
122  }  }
123    
Legend:
Removed from v.222  
changed lines
  Added in v.223
  ViewVC Help
Powered by ViewVC 1.1.26