tools/Vcard2Ldap.pm

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