tools/Vcard2Ldap.pm

   1 package Vcard2Ldap;
   2
   3 #### CONFIG
   4
   5 our $jabberd  = "jabber.domain.com";
   6
   7 my $vcardtpl = "../ldap/vcard.xml";
   8
   9 my $basedn = "dc=nodomain";
  10 my $ldapserver = "localhost";
  11 my $disname="cn=admin,dc=nodomain";
  12 my $ldappass= "secret";
  13 my $ldapperson = "irisPerson";
  14 my $ldapchatroom = "";
  15
  16 my $ldapgroup = "ou";
  17 my $ldapgroupmatch = "";
  18 my $ldapjid = "irisUserPresenceID";
  19 my $ldapjidmatch = qr/urn:mace:rediris.es:presence:xmpp:([\w\-_\.]+@.+)/;
  20
  21 ##########################
  22
  23 =head1 NAME
  24
  25 Vcard2Ldap - Stuff for convert LDAP entries to Jabberd roster ones.
  26
  27 =head1 SYNOPSIS
  28
  29     use Vcard2Ldap;
  30     my $ldap = Vcard2Ldap::ldap_open ();
  31     my $users = Vcard2Ldap::jabber_get_users ($ldap);
  32     my $vcard2ldap = Vcard2Ldap::vcard_get_map ();
  33
  34    foreach ($users) {
  35         print $_->{"jid"} . "\n";
  36         print $_->{"rostergroup"} . "\n";
  37    }
  38
  39     my $us = $ldap->search (
  40         base => "dc=nodomain",
  41         scope => "one",
  42         filter => "(cn=*)"
  43      );
  44
  45      foreach ($us->entries) {
  46          print Vcard2Ldap::jabber_jid ($_) . "\n";
  47     }
  48
  49     $ldap->unbind;
  50
  51     print $vcard2ldap->{"FN"} . "\n";
  52     #...
  53
  54 =head1 DESCRIPTION
  55
  56 This module isn't intend for general usage, it was made for the sole purpose of
  57 working together with vcard2ldap jabberd module.
  58
  59 See http://repo.or.cz/w/vcard2ldap.git for details.
  60
  61 =head2 GLOBALS
  62
  63 =over 12
  64
  65 List of global variables.
  66
  67 =item C<$jabberd>
  68
  69 The jabberd server hostname
  70
  71 =item C<$groupname>
  72
  73 The name of the roster group where jids will be stored.
  74
  75 =head2 FUNCTIONS
  76
  77 List of public functions.
  78
  79 =item C<ldap_open>
  80
  81 Open connection. Returns a LDAP handler.
  82
  83 =item C<jabber_get_users>
  84
  85 Returns a list of records: {jid,group}
  86
  87 =item C<jabber_jid>
  88
  89 Returns a jid from an LDAP entry. Empty string if none.
  90
  91 =item C<jabber_group>
  92
  93 Returns the list of groups of the LDAP entry. Empty array if none.
  94
  95 =item C<vcard_get_map>
  96
  97 Returns the "vCard map". This hash maps XML vCard tags to LDAP attributes.
  98
  99 =cut
 100
 101 use strict;
 102 use XML::Simple;
 103 use Net::LDAP;
 104 use Net::LDAP::Control;
 105
 106 my @users;
 107
 108 sub ldap_open {
 109     my $ldap = Net::LDAP->new ($ldapserver, debug => 0) or die "$@";
 110     my $mesg = $ldap->bind (
 111         $disname,
 112         password => $ldappass,
 113         version => 3) or die "Cannot bind to ldap server ($!)";
 114
 115     die $mesg->error if $mesg->code;
 116
 117     return $ldap;
 118 }
 119
 120 sub ldap_get_users {
 121     my $ldap = shift;
 122
 123     my $us = $ldap->search (
 124                   base => "$basedn",
 125                   scope => "one",
 126                   filter => "(&(objectClass=$ldapperson)($ldapgroup=*))"
 127           );
 128     die $us->error if $us->code;
 129
 130     if ($#users == -1) {
 131         add_users ($us);
 132         add_chatrooms ($ldap) if (length ($ldapchatroom) > 0);
 133     }
 134
 135     return $us->entries;
 136 }
 137
 138 sub jabber_get_users {
 139     my $ldap = shift;
 140
 141     ldap_get_users ($ldap) if ($#users == -1);
 142
 143     return @users;
 144 }
 145
 146 sub jabber_user {
 147     my $ujid = shift;
 148
 149     foreach (Vcard2Ldap::jabber_get_users ()) {
 150          return $_ if ($_->{"jid"} eq $ujid);
 151     }
 152
 153    warn $ujid . ": user not in directory or malformed entry!";
 154    return "";
 155 }
 156
 157 sub jabber_jid {
 158     my $user = shift;
 159     my $attr = $user->get_value ($ldapjid, asref => 1);
 160     my $jid = "";
 161
 162     if ($attr) {
 163         foreach (@{$attr}) {
 164             if (length ($ldapjidmatch) == 0) {
 165                 $jid = lc ($_);
 166             } elsif ($_ =~ $ldapjidmatch) {
 167                 $jid = lc ($1);
 168             }
 169
 170             if ($jid) {
 171                 if (index ($jid, "@") == -1) {
 172                     $jid .= "\@$jabberd";
 173                 }
 174                 last;
 175             }
 176         }
 177     }
 178
 179     warn $user->get_value ("cn") . ": user with no jid!" if (!$jid);
 180     return $jid;
 181 }
 182
 183 sub jabber_group {
 184     my $user = shift;
 185     my $attr = $user->get_value ($ldapgroup, asref => 1);
 186     my @group = ();
 187
 188     if ($attr) {
 189         foreach (@{$attr}) {
 190             my $tmp;
 191
 192             if (length ($ldapgroupmatch) == 0) {
 193                 $tmp = lc ($_);
 194             } elsif ($_ =~ $ldapgroupmatch) {
 195                 $tmp = lc ($1);
 196             }
 197
 198             (push @group, $tmp) if ($tmp);
 199         }
 200     }
 201
 202     if ($#group == -1) {
 203         warn $user->get_value ("cn") . ": group is mandatory!";
 204     }
 205
 206     return @group;
 207 }
 208
 209 sub vcard_get_map {
 210     my $xs = new XML::Simple (keeproot => 0, suppressempty => 1);
 211     my $vcard = $xs->XMLin ($vcardtpl);
 212     my $vcard2ldap;
 213
 214     while (my ($key, $value) = each (%$vcard)) {
 215         for (split (/\n/, parse_vcard ($key, $value))) {
 216             my @sp = split (/ /, $_);
 217             $vcard2ldap->{$sp[0]} = $sp[1];
 218         }
 219     }
 220
 221     return $vcard2ldap;
 222 }
 223
 224 ### private
 225
 226 sub add_users {
 227     my $us = shift;
 228
 229     foreach ($us->entries) {
 230         my $jid = jabber_jid ($_);
 231         my @rgroup = jabber_group ($_);
 232
 233         if ($jid) {
 234             foreach (@rgroup) {
 235                 push @users , {
 236                       "jid" => $jid,
 237                       "rostergroup" => $_
 238                 }
 239             }
 240         }
 241     }
 242 }
 243
 244 sub add_chatrooms {
 245     my $ldap = shift;
 246
 247     my $us = $ldap->search (
 248                   base => "$basedn",
 249                   scope => "one",
 250                   filter => "(&(objectClass=$ldapchatroom)($ldapgroup=*))"
 251           );
 252
 253     die $us->error if $us->code;
 254
 255     add_users ($us);
 256 }
 257
 258 sub parse_vcard {
 259     my $key = shift;
 260     my $value = shift;
 261     my $ret = "";
 262
 263     if (!ref ($value) && !($key eq "xmlns")) {
 264         $ret .= $key . " " . $value . "\n";
 265     } elsif (ref ($value) eq "HASH" ) {
 266         for (keys %$value) {
 267             if ($_ eq "v2ln") {
 268                 next;
 269             } elsif ($_ eq "content") {
 270                 $ret .= "$key". parse_vcard ("", $value->{$_});
 271             } else {
 272                 $ret .= "$key/". parse_vcard ($_, $value->{$_});
 273             }
 274         }
 275     } elsif (ref ($value) eq "ARRAY") {
 276         for (@$value) {
 277             $ret .= "$key" . parse_vcard ("", $_);
 278         }
 279     }
 280
 281     return $ret;
 282 }
 283
 284 1;