Limit the number of simultaneous connect attempts passed to libpurple.

[thrasher.git] / perl / lib / Thrasher / Backend / XDB.pm

package Thrasher::Backend::XDB;
use strict;
use warnings;

use base 'Thrasher::Backend';

use XML::DOM;
use Data::Dumper;
use Digest::MD5 qw(md5_hex);

=pod

=head1 NAME

Thrasher::Backend::XDB - Read-only XDB-based backend storage, for
migration from python transports

=head1 DESCRIPTION

PyAIMt ( http://code.google.com/p/pyaimt/ ), PyICQt 
( http://code.google.com/p/pyicqt/ ), and PyMSNt
( http://delx.net.au/projects/pymsnt/ ) all use some variant on
"XDB", which is a format the old Jabber world used a lot when
storing things on disk. This module exists primarily to 
read those files and thereby provide a clean transition path away
from Py* to Thrasher Bird. It is not a generic "XDB" reader,
if XDB is even a specified standard anywhere.

Some minor differences between how the three transports used
the file require you to specify which transport you are 
transitioning away from.

XDB files tend to look like this (with suitable substitutions for 
account name and password, of course):

 <xdb>
   <query xmlns='jabber:iq:register' xdbns='jabber:iq:register'>
     <username>[legacy username]</username>
     <password>[legacy password]</password>
   </query>
   <query xdbns='jabber:iq:roster' xmlns='jabber:iq:roster'>
     <item jid='test_account@something.invalid'/>
     <item jid='another_account@else.invalid'/>
   </query>
 </xdb>

The transports store additional, apparently useless data with the
roster items, and this format notably does not appear to correctly
store gateway-format-translated names. (In fact looking at how
these files are used by the three transports, I'm not sure how
they can work correctly with some pathological cases at all.)

Because this format neither contains nor stores enough information
for Thrasher to work correctly (it would only be able to work
half-correctly), this can only be used for import purposes.

=head1 CONFIGURATION

XDB requires some parameters to work:

=over 4

=back


=cut

sub new {
    my $class = shift;
    my $parameters = shift;

    my $self = bless $parameters, $class;

    my @missing;
    for my $required qw(directory component_name) {
        if (!defined($self->{$required})) {
            push @missing, $required;
        }
    }
    if (@missing) {
        die "$class required the following parameters that weren't "
            ."provided: " . join(', ', @missing);
    }

    if (!-e $self->{directory}) {
        die "XDB source directory $self->{directory} does not exist.";
    }
    if (!-d $self->{directory}) {
        die "XDB source directory $self->{directory} is not a directory";
    }

    return $self;
}

sub all_jids {
    my $self = shift;

    my @possible_jids;
    for my $xml_file (glob($self->{directory} . "/*/*")) {
        if ($xml_file =~ /.*\/([^%]+)%([^%]+?)\.xml/) {
            push @possible_jids, "$1\@$2";
        }
    }

    return \@possible_jids;
}

# This is the meat of this file, which actually loads up a user
# and loads in the roster and registration information, isolating
# most of the differences into this function. OO dogma would have
# me subclass three classes and change this method, but that's just
# silly-heavy-weightness.
sub load_user {
    my $self = shift;
    my $jid = shift;

    if (my $info = $self->{user_info}->{$jid}) {
        return $info;
    }

    my $filename = $jid;
    $filename =~ s/\@/\%/;
    $filename .= '.xml';
    if ($self->{flavor} eq 'pyaim' || $self->{flavor} eq 'pyicq') {
        my $subdir = substr $jid, 0, 2;
        $filename = "$self->{directory}/$subdir/$filename";
    } elsif ($self->{flavor} eq 'pymsn') {
        my $md5_portion = $jid;
        $md5_portion =~ s/\@/\%/;
        my $subdir = md5_hex($md5_portion);
        $subdir = substr $subdir, 0, 3;
        $filename = "$self->{directory}/$subdir/$filename";
    } else {
        die "Can't load a user unless flavor is one of "
            .'pyaim, pymsn, or pyicq.';
    }

    if (!-e $filename) {
        die "While trying to load user info for $jid, "
            ."couldn't find data file $filename.";
    }

    my $dom = XML::DOM::Parser->new;
    my $doc = $dom->parsefile($filename);

    my $queries = $doc->getElementsByTagName('query');
   
    $self->{user_info}->{$jid} = {};
    
    for (my $i = 0; $i < $queries->getLength; $i++) {
        my $query = $queries->item($i);

        my $namespace = $query->getAttributeNode('xdbns')->getValue;

        if ($namespace eq 'jabber:iq:register') {
            my $username =
                $query->getElementsByTagName('username')->item(0)->getFirstChild->getData;
            my $password =
                $query->getElementsByTagName('password')->item(0)->getFirstChild->getData;
            $self->{user_info}->{$jid}->{registration} = 
                {username => $username, 
                 password => $password};
        } elsif ($namespace eq 'jabber:iq:roster') {
            my $items = $query->getElementsByTagName('item');
            my $roster = [];
            for (my $j = 0; $j < $items->getLength; $j++) {
                my $item = $items->item($j);
                my $legacy_name =
                    $item->getAttributeNode('jid')->getValue;
                my $jid = $self->legacy_name_to_jid
                    ($jid, $legacy_name, $self->{component_name});
                push @$roster, $jid;
            }
            $self->{user_info}->{$jid}->{roster} = $roster;
        }
    }

    return $self->{user_info}->{$jid};
}

sub retrieve_legacy_name_to_jid {
    my $self = shift;
    my $user_jid = shift;
    my $legacy_username = shift;

    if ($self->{user_info}->{$user_jid}) {
        return $self->{user_info}->{$user_jid}->{legacy_to_jid}->{$legacy_username};
    }
    
    return $self->load_user($user_jid)->{legacy_to_jid}->{$legacy_username};
}

sub jid_has_legacy_name {
    my $self = shift;
    my $user_jid = shift;
    my $target_jid = shift;

    return
        !!($self->load_user($user_jid)->{jid_to_legacy}->{$target_jid});
}

sub store_username_mapping {
    my $self = shift;
    my $user_jid = shift;
    my $legacy_username = shift;
    my $mapped_jid = shift;

    my $data = $self->load_user($user_jid);

    $data->{jid_to_legacy}->{$mapped_jid} = $legacy_username;
    $data->{legacy_to_jid}->{$legacy_username} = $mapped_jid;
}

sub registered {
    my $self = shift;
    my $jid = shift;
    
    return $self->load_user($jid)->{registration};
}

# While some of these transports supported avatars, it's easier
# just to re-retrieve them.
sub get_avatar {
    return undef;
}

sub all_avatars {
    return {};
}

sub get_roster {
    return {};
}

sub all_mappings {
    my $self = shift;
    my $jid = shift;

    return $self->load_user($jid)->{legacy_to_jid};
}

sub all_misc {
    return {};
}



1;