tools/Vcard2Ldap.pm

   1 package Vcard2Ldap;
   2
   3 =head1 NAME
   4
   5 Vcard2Ldap - Stuff for convert LDAP entries to Jabberd roster ones.
   6
   7 =head1 SYNOPSIS
   8
   9     use Vcard2Ldap;
  10     my $ldap = Vcard2Ldap::ldap_open ();
  11     my $users = Vcard2Ldap::jabber_get_users ($ldap);
  12     #...
  13
  14 =head1 DESCRIPTION
  15
  16 This module isn't intend for general usage, it was made for the sole purpose of
  17 working together with vcard2ldap jabberd module.
  18
  19 See http://repo.or.cz/w/vcard2ldap.git for details.
  20
  21 =head2 GLOBALS
  22
  23 =over 12
  24
  25 List of global variables.
  26
  27 =item C<$jabberd>
  28
  29 The jabberd server hostname
  30
  31 =item C<$groupname>
  32
  33 The name of the roster group where jids will be stored.
  34
  35 =head2 FUNCTIONS
  36
  37 List of public functions.
  38
  39 =item C<ldap_open>
  40
  41 Open connection. Returns a LDAP handler.
  42
  43 =item C<jabber_get_users>
  44
  45 Returns a list of records: {jid,group}
  46
  47 =item C<jabber_jid>
  48
  49 Returns a jid from an LDAP entry.
  50
  51 =item C<vcard_get_map>
  52
  53 Returns the "vCard map". This hash maps XML vCard tags to LDAP attributes.
  54
  55 =cut
  56
  57 #### CONFIG
  58 our $jabberd  = "jabber.domain.com";
  59 our $groupname = "Iris";
  60
  61 my $vcardtpl = "../ldap/vcard.xml";
  62
  63 my $basedn = "dc=nodomain";
  64 my $ldapserver = "localhost";
  65 my $disname="cn=admin,dc=nodomain";
  66 my $ldappass= "secret";
  67 my $ldapperson = "irisPerson";
  68 my $ldapgroup = "ou";
  69
  70 my $ldapjidattr = "irisUserPresenceID";
  71 my $ldapjidmatch = qr/urn:mace:rediris.es:presence:xmpp:([\w\-_\.]+@.+)/;
  72
  73 ##########################
  74
  75 use strict;
  76 use XML::Simple;
  77 use Net::LDAP;
  78 use Net::LDAP::Control;
  79
  80 my @users;
  81
  82 sub ldap_open {
  83     my $ldap = Net::LDAP->new ($ldapserver, debug => 0) or die "$@";
  84     my $mesg = $ldap->bind (
  85         $disname,
  86         password => $ldappass,
  87         version => 3) or die "Cannot bind to ldap server. $!";
  88
  89     die $mesg->error if $mesg->code;
  90
  91     return $ldap;
  92 }
  93
  94 sub ldap_get_users {
  95     my $ldap = shift;
  96
  97     my $us = $ldap->search(
  98                   base => "$basedn",
  99                   scope => "one",
 100                   filter => "(&(objectClass=$ldapperson)($ldapgroup=*))"
 101           );
 102     die $us->error if $us->code;
 103
 104     if ($#users == -1) {
 105       set_users ($us);
 106     }
 107
 108     return $us->entries;
 109 }
 110
 111 sub jabber_get_users {
 112     if ($#users == -1) {
 113         my $ldap = shift;
 114         ldap_get_users ($ldap);
 115     }
 116
 117     return @users;
 118 }
 119
 120
 121 sub jabber_jid {
 122     my $user = shift;
 123     my $jid;
 124
 125     foreach (@{$user->get_value ($ldapjidattr, asref => 1)}) {
 126         if (length ($ldapjidmatch) == 0) {
 127             return $_;
 128         } else {
 129            $jid = $_ =~ $ldapjidmatch;
 130
 131            if (length ($jid) != 0) {
 132                return $jid;
 133            }
 134         }
 135     }
 136
 137    die user->get_value ("cn") . ": user with no jid!";
 138 }
 139
 140 sub vcard_get_map {
 141     my $xs = new XML::Simple (keeproot => 0, suppressempty => 1);
 142     my $vcard = $xs->XMLin($vcardtpl);
 143     my $vcard2ldap;
 144
 145     while (my ($key, $value) = each (%$vcard)) {
 146         for (split(/\n/, parse_vcard ($key, $value))) {
 147             my @sp = split(/ /, $_);
 148             $vcard2ldap->{$sp[0]} = $sp[1];
 149         }
 150     }
 151
 152     return $vcard2ldap;
 153 }
 154
 155 ### private
 156
 157 sub set_users {
 158     my $us = shift;
 159
 160     foreach ($us->entries) {
 161         push @users , {
 162           "jid" => jabber_jid ($_),
 163           "rostergroup" => $_->get_value ($ldapgroup)
 164         };
 165       }
 166 }
 167
 168 sub parse_vcard {
 169     my $key = shift;
 170     my $value = shift;
 171     my $ret ="";
 172
 173     if (!ref ($value) && !($key eq "xmlns")) {
 174         $ret = $ret . $key ." " . $value . "\n";
 175     } elsif (ref ($value) eq "HASH" ) {
 176         for my $k2 ( keys %$value ) {
 177             if ($k2 eq "v2ln") {
 178                 next;
 179             } elsif ($k2 eq "content") {
 180                 $ret = $ret . "$key". parse_vcard ('', $value->{$k2});
 181             } else {
 182                 $ret = $ret . "$key/". parse_vcard ($k2, $value->{$k2});
 183             }
 184         }
 185     } elsif (ref ($value) eq "ARRAY") {
 186         for (@$value) {
 187             $ret = $ret . "$key" . parse_vcard ('', $_);
 188         }
 189     }
 190
 191     return $ret;
 192 }
 193
 194 1;