my $COMP_HOST = 'localhost';
my $COMP_PORT = 7000;
my $COMP_NAME = 'migrate';
my $COMP_SECRET = 'secret';
my $DB_TYPE = 'mysql';
my $DB_HOST = 'localhost';
my $DB_PORT = 3306; my $DB_NAME = 'jabberd2';
my $DB_USER = 'jabberd2';
my $DB_PASS = 'secret';
my $USER_FILE = "migrate-users";
my @DATA_TYPES = qw(roster active auth);
my $AUTH_REALM = 'gideon.its.monash.edu.au';
use strict;
use DBI;
use Digest::SHA1 qw(sha1_hex);
use Net::Jabber::XDB;
$Net::Jabber::XDB::FUNCTIONS{XDB}->{XPath}->{Type} = 'master';
use Net::Jabber 1.29 qw(Component);
package Net::Jabber::XDB;
$FUNCTIONS{Data}->{XPath}->{Type} = 'node';
$FUNCTIONS{Data}->{XPath}->{Path} = '*[@xmlns]';
$FUNCTIONS{Data}->{XPath}->{Child} = 'Data';
$FUNCTIONS{Data}->{XPath}->{Calls} = ['Get','Defined'];
package Net::Jabber::Data;
$FUNCTIONS{XMLNS}->{XPath}->{Path} = '@xmlns';
$FUNCTIONS{Data}->{XPath}->{Type} = 'node';
$FUNCTIONS{Data}->{XPath}->{Path} = '*[@xmlns]';
$FUNCTIONS{Data}->{XPath}->{Child} = 'Data';
$FUNCTIONS{Data}->{XPath}->{Calls} = ['Get','Defined'];
my $ns;
$ns = 'jabber:iq:auth';
$NAMESPACES{$ns}->{Password}->{XPath}->{Path} = 'text()';
$NAMESPACES{$ns}->{Auth}->{XPath}->{Type} = 'master';
$ns = 'jabber:iq:register';
$NAMESPACES{$ns}->{Register}->{XPath}->{Type} = 'master';
$ns = 'jabber:iq:roster';
$NAMESPACES{$ns}->{Item}->{XPath}->{Type} = 'node';
$NAMESPACES{$ns}->{Item}->{XPath}->{Path} = 'item';
$NAMESPACES{$ns}->{Item}->{XPath}->{Child} = ['Data','__netjabber__:iq:roster:item'];
$NAMESPACES{$ns}->{Item}->{XPath}->{Calls} = ['Add'];
$NAMESPACES{$ns}->{Items}->{XPath}->{Type} = 'children';
$NAMESPACES{$ns}->{Items}->{XPath}->{Path} = 'item';
$NAMESPACES{$ns}->{Items}->{XPath}->{Child} = ['Data','__netjabber__:iq:roster:item'];
$NAMESPACES{$ns}->{Items}->{XPath}->{Calls} = ['Get'];
$ns = '__netjabber__:iq:roster:item';
$NAMESPACES{$ns}->{Ask}->{XPath}->{Path} = '@ask';
$NAMESPACES{$ns}->{Group}->{XPath}->{Type} = 'array';
$NAMESPACES{$ns}->{Group}->{XPath}->{Path} = 'group/text()';
$NAMESPACES{$ns}->{JID}->{XPath}->{Type} = 'jid';
$NAMESPACES{$ns}->{JID}->{XPath}->{Path} = '@jid';
$NAMESPACES{$ns}->{Name}->{XPath}->{Path} = '@name';
$NAMESPACES{$ns}->{Subscription}->{XPath}->{Path} = '@subscription';
$NAMESPACES{$ns}->{Item}->{XPath}->{Type} = 'master';
package main;
$| = 1;
print "Loading user file\n";
open IN, $USER_FILE or die "couldn't open $USER_FILE for reading: $!";
my @users = grep { chomp } <IN>;
close IN;
die "unknown database type '$DB_TYPE'" if $DB_TYPE ne 'mysql' and $DB_TYPE ne 'pgsql';
print "Connecting to database\n";
my $dbh;
eval {
if($DB_TYPE eq 'mysql') {
$dbh = DBI->connect("dbi:mysql:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 0, RaiseError => 1 });
} else {
$dbh = DBI->connect("dbi:Pg:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 0, RaiseError => 1 });
}
};
if($@) {
die "db connect error: $@";
}
print "Connecting to jabber server\n";
my $c = new Net::Jabber::Component(
);
$c->Connect(
hostname => $COMP_HOST,
port => $COMP_PORT,
secret => $COMP_SECRET,
componentname => $COMP_NAME,
connectiontype => 'accept');
$c->Connected or die "$0: connect to jabber server failed";
my ($iq, $xdb, $res);
print scalar @users, " users to migrate\n";
foreach my $user (@users) {
print "Converting data for $user...\n";
my $data = { };
for(@DATA_TYPES) {
print " $_\n";
eval '_migrate_'.$_.'($data, $user)';
warn "$@" if $@;
}
print "Writing to database... ";
eval {
my ($rows, $tables) = (0, 0);
foreach my $type (keys %$data) {
foreach my $item (@{$data->{$type}}) {
my $sql = 'INSERT INTO ' . _sql_literal($type) . " ( ";
for(keys %$item) {
$sql .= _sql_literal($_) . ', ';
}
$sql =~ s/, $/) VALUES ( /;
for(keys %$item) {
$sql .= $item->{$_} . ', ';
}
$sql =~ s/, $/)/;
$dbh->do($sql);
$rows++;
}
$tables++;
}
$dbh->commit;
print "inserted $rows rows into $tables tables.\n";
};
if($@) {
warn "db error: $@";
$dbh->rollback;
}
}
$dbh->disconnect;
sub _sql_literal {
my $arg = shift;
return "\"$arg\"" if $DB_TYPE eq 'pgsql';
return "\`$arg\`";
}
sub _xdb_get {
my ($user, $ns) = @_;
my $xdb = new Net::Jabber::XDB;
$xdb->SetXDB(
to => $user,
from => $COMP_NAME,
type => 'get',
ns => $ns);
return $c->SendAndReceiveWithID($xdb);
}
sub _object_quote {
$dbh->quote(shift);
}
sub _object_new {
my $item;
$item->{'collection-owner'} = _object_quote(shift);
$item->{'object-sequence'} = "nextval('object-sequence')" if $DB_TYPE eq 'pgsql';
return $item;
}
sub _migrate_roster {
my ($data, $user) = @_;
my $xdb = _xdb_get($user, 'jabber:iq:roster');
my $roster = $xdb->GetData or return;
my @items = $roster->GetItems;
for(@items) {
my $item = _object_new($user);
$item->{'jid'} = _object_quote($_->GetJID);
$item->{'name'} = _object_quote($_->GetName) if $_->GetName;
my $s10n = $_->GetSubscription;
if(not $s10n or $s10n eq 'none') {
$item->{'to'} = _object_quote('0');
$item->{'from'} = _object_quote('0');
} elsif($s10n eq 'both') {
$item->{'to'} = _object_quote('1');
$item->{'from'} = _object_quote('1');
} elsif($s10n eq 'to') {
$item->{'to'} = _object_quote('1');
$item->{'from'} = _object_quote('0');
} elsif($s10n eq 'from') {
$item->{'to'} = _object_quote('0');
$item->{'from'} = _object_quote('1');
}
my $ask = $_->GetAsk;
if(not $ask) {
$item->{'ask'} = 0;
} elsif($ask eq 'subscribe') {
$item->{'ask'} = 1;
} elsif($ask eq 'unsubscribe') {
$item->{'ask'} = 2;
}
push @{$data->{'roster-items'}}, $item;
my $jid = $item->{'jid'};
my @groups = $_->GetGroup;
for(@groups) {
my $item = _object_new($user);
$item->{'jid'} = $jid;
$item->{'group'} = _object_quote($_);
push @{$data->{'roster-groups'}}, $item;
}
}
}
sub _migrate_active {
my ($data, $user) = @_;
my $item = _object_new($user);
$item->{'time'} = time();
push @{$data->{'active'}}, $item;
}
sub _migrate_auth {
my ($data, $user) = @_;
my $xdb = _xdb_get($user, 'jabber:iq:auth');
my $auth = $xdb->GetData or return;
my $item;
$user =~ m/^(.*)\@/;
$item->{'username'} = _object_quote($1);
$item->{'realm'} = _object_quote($AUTH_REALM);
my $pass = $auth->GetPassword;
$item->{'password'} = _object_quote($pass);
my $seq = 500;
my $token = sprintf "%X", time();
my $h = sha1_hex(sha1_hex($pass) . $token);
for(my $i = 0; $i < $seq; $i++) {
$h = sha1_hex($h);
}
$item->{'token'} = _object_quote($token);
$item->{'sequence'} = $seq;
$item->{'hash'} = _object_quote($h);
push @{$data->{'authreg'}}, $item;
}
sub _migrate_vcard {
my ($data, $user) = @_;
my $xdb = _xdb_get($user, 'vcard-temp');
my $vcard = $xdb->GetData or return;
}