tools/jabber2db.pl

   1 #!/usr/bin/perl
   2
   3 #### CONFIG
   4 my $vcardtpl = "../ldap/vcard.xml";
   5 my $jabberd  = "jabber.domain.com";
   6 my $groupname = "Iris";
   7
   8 my $basedn = "dc=nodomain";
   9 my $ldapserver = "localhost";
  10 my $disname="cn=admin,dc=nodomain";
  11 my $ldappass= "secret";
  12 my $ldapperson = "irisPerson";
  13 my $ldapgroup = "ou";
  14
  15 my $db = "Pg"; # Pg : PostgresSQL, mysql: MySQL...
  16 my $dbuser = "jabber";
  17 my $dbpass = "secret";
  18 my $dbname = "jabberd2";
  19
  20 ##########################
  21 use strict;
  22 use Getopt::Std;
  23 use XML::Simple;
  24 use Data::Dumper;
  25 use Net::LDAP;
  26 use Net::LDAP::Control;
  27 use DBI;
  28
  29 my $vcard2db = {
  30     "FN" => "fn",
  31     "NICKNAME" => "nickname",
  32     "URL" => "url",
  33     "TEL/NUMBER" => "tel",
  34     "EMAIL/USERID" => "email",
  35     "TITLE" => "title",
  36     "ROLE" => "role",
  37     "BDAY" => "bday",
  38     "DESC" => "desc",
  39     "N/FAMILY" => "n-family",
  40     "N/GIVEN" => "n-given",
  41     "N/MIDDLE" => "n-middle",
  42     "N/PREFIX" => "n-prefix",
  43     "N/SUFFIX" => "n-suffix",
  44     "ADR/STREET" => "adr-street",
  45     "ADR/POBOX" => "adr-pobox",
  46     "ADR/EXTADD" => "adr-extadd",
  47     "ADR/LOCALITY" => "adr-locality",
  48     "ADR/REGION" => "adr-region",
  49     "ADR/PCODE" => "adr-pcode",
  50     "ADR/CTRY" => "adr-country",
  51     "ORG/ORGNAME" => "org-orgname",
  52     "ORG/ORGUNIT" => "org-orgunit",
  53
  54     "TZ" => "tz",
  55     "GEO/LAT" => "geo-lat",
  56     "GEO/LON" => "geo-lon",
  57     "AGENT/EXTVAL" => "agent-extval",
  58     "NOTE" => "note",
  59     "REV" => "rev",
  60     "SORT-STRING" => "sort-string",
  61
  62     "KEY/TYPE" => "key-type",
  63     "KEY/CRED" => "key-cred",
  64
  65     "PHOTO/TYPE" => "photo-type",
  66     "PHOTO/BINVAL" => "photo-binval",
  67     "PHOTO/EXTVAL" => "photo-extval",
  68
  69     "LOGO/TYPE" => "logo-type",
  70     "LOGO/BINVAL" => "logo-binval",
  71     "LOGO/EXTVAL" => "logo-extval",
  72
  73     "SOUND/PHONETIC" => "sound-phonetic",
  74     "SOUND/BINVAL" => "sound-binval",
  75     "SOUND/EXTVAL" => "sound-extval"
  76 };
  77
  78 my (@users, $ldap, $dbh, $vcard2ldap);
  79 my $option_populate = 0;
  80 my $option_one_user = 0;
  81
  82 ### MAIN
  83 if ($#ARGV == 0) {
  84     if ($ARGV[0] eq "-p" || $ARGV[0] eq "--populate") {
  85         $option_populate = 1;
  86     } elsif ($ARGV[0] =~ /^[a-z\-_\.]+\@$jabberd/){
  87         $option_one_user = 1;
  88     } else {
  89         usage ();
  90     }
  91 } elsif ($#ARGV > 0) {
  92     usage ();
  93 }
  94
  95 $ldap = ldap_open ();
  96 $dbh = db_open ();
  97 $vcard2ldap = vcard2ldap_map ();
  98
  99 set_all_vcards ($basedn, $ldapgroup);
 100
 101 populate_user_roster ($ARGV[0]) if $option_one_user;
 102 populate_all_rosters () if $option_populate;
 103
 104 exit;
 105
 106 sub usage {
 107     print "usage: jabber2db [-p|--purge]\n";
 108     exit (1);
 109 }
 110
 111 sub set_all_vcards {
 112         my $searchdn = shift;
 113         my $rostergroup = shift;
 114
 115     db_delete_vcards () if $option_populate;
 116
 117         # query the user names
 118         my $us = $ldap->search(
 119                 base => "$searchdn",
 120                 scope => "one",
 121                 filter => "(&(objectClass=$ldapperson)($ldapgroup=*))"
 122               );
 123         die $us->error if $us->code;
 124
 125         # fetch the usernames
 126         foreach ($us->entries) {
 127             db_set_vcard ($_);
 128         }
 129 }
 130
 131 sub db_delete_vcards {
 132     my $query;
 133
 134     $query = "DELETE FROM \"vcard\"";
 135     $dbh->do("$query") or die ("Cannot delete vcards!\n");
 136 }
 137
 138 sub db_delete_rosters {
 139     my $query;
 140
 141     $query = "DELETE FROM \"roster-items\"";
 142     $dbh->do("$query") or die ("Cannot delete roster-items!\n");
 143     $query = "DELETE FROM \"roster-groups\"";
 144     $dbh->do("$query") or die ("Cannot delete roster-groups!\n");
 145 }
 146
 147 sub db_insert_vcard {
 148     my $pers = shift;
 149
 150     my $squery = '';
 151     my $ssquery = '';
 152     my $query = '';
 153     my $sth;
 154
 155     my $collection_owner = $pers->get_value("cn"). '@' . $jabberd;
 156
 157     $query = "INSERT INTO vcard (\"collection-owner\"";
 158
 159     while (my ($key, $value) = each(%$vcard2db)) {
 160         if ($vcard2ldap->{$key} && $pers->get_value ($vcard2ldap->{$key})) {
 161             $squery = $squery . ", \"". $value . "\"";
 162             $ssquery = $ssquery .
 163             $dbh->quote ($pers->get_value ($vcard2ldap->{$key})) . ",";
 164         }
 165     }
 166
 167     chop($ssquery);
 168
 169     $query = $query . $squery . ") VALUES ('$collection_owner', " .
 170              $ssquery . ")";
 171
 172     $sth = $dbh->prepare($query) or die("Cannot prepare query! ($!)");
 173     $sth->execute or die("Cannot execute query! ($!) \n $query");
 174     $sth->finish;
 175 }
 176
 177 sub db_update_vcard {
 178     my $pers = shift;
 179
 180     my $squery = '';
 181     my $ssquery = '';
 182     my $query = '';
 183     my $sth;
 184
 185     my $collection_owner = $pers->get_value("cn"). '@' . $jabberd;
 186
 187     $query = "UPDATE vcard SET ";
 188
 189     while (my ($key, $value) = each(%$vcard2db)) {
 190         if ($vcard2ldap->{$key} && $pers->get_value ($vcard2ldap->{$key})) {
 191             $query = $query . "\"". $value . "\" = " .
 192                      $dbh->quote ($pers->get_value ($vcard2ldap->{$key})) . ",";
 193         }
 194     }
 195
 196     chop($query);
 197
 198     $query = $query . " WHERE \"collection-owner\" = " .
 199              $dbh->quote ($collection_owner);
 200
 201     $sth = $dbh->prepare($query) or die ("Cannot prepare query! ($!)");
 202     $sth->execute or die ("Cannot execute query! ($!) \n $query");
 203     $sth->finish;
 204 }
 205
 206 sub db_set_vcard {
 207     my $pers = shift;
 208     my $is_update = 0;
 209     my $query;
 210     my $sth;
 211
 212     my $collection_owner = $pers->get_value("cn"). '@' . $jabberd;
 213
 214     if (!$option_populate) {
 215         $query = "SELECT * FROM vcard WHERE \"collection-owner\" = " .
 216                   $dbh->quote ($collection_owner);
 217         $sth = $dbh->prepare($query) or die("Cannot prepare query! ($!)");
 218         $sth->execute or die ("Cannot execute query! ($!) \n $query");
 219         $is_update = $sth->rows > 0;
 220         $sth->finish;
 221     }
 222
 223     if ($is_update) {
 224         db_update_vcard ($pers);
 225     } else {
 226         db_insert_vcard ($pers);
 227     }
 228
 229     push @users , {
 230         "jid" => $collection_owner,
 231         "rostergroup" => $pers->get_value ($ldapgroup)
 232     };
 233 }
 234
 235 sub populate_all_rosters {
 236     my $item;
 237
 238     db_delete_rosters ();
 239
 240     foreach $item (@users) {
 241         populate_user_roster ($item->{"jid"})
 242     }
 243 }
 244
 245 sub populate_user_roster {
 246     my $ujid = shift;
 247     my $item;
 248
 249     foreach $item (@users) {
 250         db_add_user_to_roster (
 251             $ujid,
 252             $item->{"jid"},
 253             $groupname
 254         );
 255     }
 256 }
 257
 258 sub db_add_user_to_roster {
 259     my $ujid = shift;
 260     my $rjid = shift;
 261     my $groupname = shift;
 262
 263     my $query;
 264     my $sth;
 265
 266     $query = "INSERT INTO \"roster-items\" (\"collection-owner\", \"jid\", \"to\", \"from\", \"ask\") VALUES (" .
 267               $dbh->quote ($ujid) . "," .
 268               $dbh->quote ($rjid) . "," .
 269               "TRUE, TRUE, 0 )";
 270
 271     $sth = $dbh->prepare($query);
 272     $sth->execute or die ("Cannot execute query! ($!)");
 273
 274
 275     $query = "INSERT INTO \"roster-groups\" (\"collection-owner\", \"jid\", \"group\") VALUES (" .
 276               $dbh->quote ($ujid) . "," .
 277               $dbh->quote ($rjid) . "," .
 278               $dbh->quote ($groupname) . ")";
 279
 280     $sth = $dbh->prepare($query);
 281     $sth->execute or warn  ("Cannot add roster group! ($!)");
 282
 283 }
 284
 285 sub ldap_open {
 286     my $ldap = Net::LDAP->new ($ldapserver, debug => 0) or die "$@";
 287     my $mesg = $ldap->bind (
 288         $disname,
 289         password => $ldappass,
 290         version => 3) or die "Cannot bind to ldap server. $!";
 291
 292     die $mesg->error if $mesg->code;
 293
 294     return $ldap;
 295 }
 296
 297 sub db_open {
 298     return DBI->connect (
 299         "DBI:$db:database=$dbname;host=localhost",
 300         $dbuser,
 301         $dbpass
 302     );
 303 }
 304
 305 sub vcard2ldap_map {
 306     my $xs = new XML::Simple(keeproot => 0, suppressempty => 1);
 307     my $vcard = $xs->XMLin($vcardtpl);
 308     my $vcard2ldap;
 309
 310     while (my ($key, $value) = each(%$vcard)) {
 311         for (split(/\n/, parse_vcard ($key, $value))) {
 312             split(/ /, $_);
 313             $vcard2ldap->{$_[0]} = $_[1];
 314         }
 315     }
 316
 317     return $vcard2ldap;
 318 }
 319
 320 sub parse_vcard {
 321     my $key = shift;
 322     my $value = shift;
 323     my $ret ="";
 324
 325     if (!ref ($value) && !($key eq "xmlns")) {
 326         $ret = $ret.$key." ".$value."\n";
 327     } elsif (ref ($value) eq "HASH" ) {
 328         for my $k2 ( keys %$value ) {
 329             if ($k2 eq "v2ln") {
 330                 next;
 331             } elsif ($k2 eq "content") {
 332                 $ret = $ret."$key".parse_vcard ('', $value->{$k2});
 333             } else {
 334                 $ret = $ret."$key/".parse_vcard ($k2, $value->{$k2});
 335             }
 336         }
 337     } elsif (ref ($value) eq "ARRAY") {
 338         for (@$value) {
 339             $ret = $ret."$key".parse_vcard ('', $_);
 340         }
 341     }
 342
 343     return $ret;
 344 }