git.rot13.org Git - virtual-ldap/blob - lib/LDAP/Koha.pm

   1 package LDAP::Koha;
   2
   3 use strict;
   4 use warnings;
   5 use Data::Dump qw/dump/;
   6
   7 use lib '../lib';
   8 use Net::LDAP::Constant qw(LDAP_SUCCESS);
   9 use Net::LDAP::Server;
  10 use base 'Net::LDAP::Server';
  11 use fields qw();
  12
  13 use DBI;
  14
  15 # XXX test with:
  16 #
  17 # ldapsearch -h localhost -p 2389 -b dc=ffzg,dc=hr -x 'otherPager=200903160021'
  18 #
  19
  20 our $dsn      = 'DBI:mysql:dbname=';
  21 our $database = 'koha';
  22 our $user     = 'unconfigured-user';
  23 our $passwd   = 'unconfigured-password';
  24
  25 our $max_results = 3; # 100; # FIXME
  26
  27 require 'config.pl' if -e 'config.pl';
  28
  29 my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;
  30
  31 # Net::LDAP::Entry will lc all our attribute names anyway, so
  32 # we don't really care about correctCapitalization for LDAP
  33 # attributes which won't pass through DBI
  34 my $sql_select = q{
  35         select
  36                 trim(userid)                                    as uid,
  37                 firstname                                               as givenName,
  38                 surname                                                 as sn,
  39                 concat(firstname,' ',surname)   as cn,
  40
  41                 -- SAFEQ specific mappings from UMgr-LDAP.conf
  42                 concat(firstname,' ',surname)   as displayName,
  43                 cardnumber                                              as otherPager,
  44                 email                                                   as mail,
  45                 categorycode                                    as organizationalUnit,
  46                 borrowernumber                                  as objectGUID,
  47                 concat('/home/',borrowernumber) as homeDirectory
  48         from borrowers
  49 };
  50
  51 # needed for where clause
  52 my $sql_ldap_mapping = {
  53         'userid'                        => 'uid',
  54         'borrowernumber'        => 'objectGUID',
  55 };
  56
  57 # attributes which are same for whole set, but somehow
  58 # LDAP clients are sending they anyway and we don't
  59 # have them in database
  60 my $ldap_ignore = {
  61         'objectclass' => 1,
  62 };
  63
  64 my $ldap_sql_mapping;
  65 while ( my ($sql,$ldap) = each %$sql_ldap_mapping ) {
  66         $ldap_sql_mapping->{ $ldap } = $sql;
  67 }
  68
  69 sub __sql_column {
  70         my $name = shift;
  71         $ldap_sql_mapping->{$name} || $name;
  72 }
  73
  74 use constant RESULT_OK => {
  75         'matchedDN' => '',
  76         'errorMessage' => '',
  77         'resultCode' => LDAP_SUCCESS
  78 };
  79
  80 # constructor
  81 sub new {
  82         my ($class, $sock) = @_;
  83         my $self = $class->SUPER::new($sock);
  84         print "connection from: ", $sock->peerhost(), "\n";
  85         return $self;
  86 }
  87
  88 # the bind operation
  89 sub bind {
  90         my $self = shift;
  91         my $reqData = shift;
  92         warn "# bind ",dump($reqData);
  93         return RESULT_OK;
  94 }
  95
  96 # the search operation
  97 sub search {
  98         my $self = shift;
  99         my $reqData = shift;
 100         print "searching...\n";
 101
 102         warn "# " . localtime() . " request = ", dump($reqData);
 103
 104         my $base = $reqData->{'baseObject'}; # FIXME use it?
 105
 106         my @entries;
 107         if ( $reqData->{'filter'} ) {
 108
 109                 my $sql_where = '';
 110                 my @values;
 111
 112                 foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
 113
 114                         warn "## join_with $join_with\n";
 115
 116                         my @limits;
 117
 118                         foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
 119                                 warn "### filter ",dump($filter),$/;
 120                                 foreach my $how ( keys %$filter ) {
 121                                         warn "### how $how\n";
 122                                         if ( $how eq 'equalityMatch' && defined $filter->{$how} ) {
 123                                                 my $name = $filter->{$how}->{attributeDesc} || warn "ERROR: no attributeDesc?";
 124                                                 my $value = $filter->{$how}->{assertionValue} || warn "ERROR: no assertionValue?";
 125                                                 if ( ! $ldap_ignore->{ $name } ) {
 126                                                                 push @limits, __sql_column($name) . ' = ?';
 127                                                                 push @values, $value;
 128                                                 }
 129                                         } elsif ( $how eq 'substrings' ) {
 130                                                 foreach my $substring ( @{ $filter->{$how}->{substrings} } ) {
 131                                                         my $name = $filter->{$how}->{type} || warn "ERROR: no type?";
 132                                                         while ( my($op,$value) = each %$substring ) {
 133                                                                 push @limits, __sql_column($name) . ' LIKE ?';
 134                                                                 if ( $op eq 'any' ) {
 135                                                                         $value = '%' . $value . '%';
 136                                                                 } else {
 137                                                                         warn "UNSUPPORTED: op $op - using plain $value";
 138                                                                 }
 139                                                                 push @values, $value;
 140                                                         }
 141                                                 }
 142                                         } elsif ( $how eq 'present' ) {
 143                                                 my $name = __sql_column( $filter->{$how} );
 144                                                 push @limits, "$name IS NOT NULL and length($name) > 1";
 145                                                 ## XXX length(foo) > 1 to avoid empty " " strings
 146                                         } else {
 147                                                 warn "UNSUPPORTED: how $how ",dump( $filter );
 148                                         }
 149                                         warn "## limits ",dump(@limits), " values ",dump(@values);
 150                                 }
 151                         }
 152
 153                         $sql_where .= ' ' . join( " $join_with ", @limits );
 154
 155                 }
 156
 157                 if ( $sql_where ) {
 158                         $sql_where = " where $sql_where";
 159                 }
 160
 161                 warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );
 162                 my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
 163                 $sth->execute( @values );
 164
 165                 warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
 166
 167                 while (my $row = $sth->fetchrow_hashref) {
 168
 169                         warn "## row = ",dump( $row );
 170
 171                         my $dn = 'uid=' . $row->{uid} || die "no uid";
 172                         $dn =~ s{[@\.]}{,dc=}g;
 173
 174                         my $entry = Net::LDAP::Entry->new;
 175                         $entry->dn( $dn . $base );
 176                         $entry->add( %$row );
 177
 178                         #warn "### entry ",dump( $entry );
 179
 180                         push @entries, $entry;
 181                 }
 182
 183         } else {
 184                 warn "UNKNOWN request: ",dump( $reqData );
 185         }
 186
 187         return RESULT_OK, @entries;
 188 }
 189
 190 # the rest of the operations will return an "unwilling to perform"
 191
 192 1;