summaryrefslogtreecommitdiffstatsabout
path: root/lib/DJabberd/RosterStorage/SQLite/Fixed.pm
blob: fe413630ab493affc647b136d18222c69e02a8a1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
package DJabberd::RosterStorage::SQLite::Fixed;
use strict;
use warnings;
use base 'DJabberd::RosterStorage::SQLite';
use DJabberd::Log;
use DJabberd::Util;
our $logger = DJabberd::Log->get_logger();

=head1 NAME

DJabberd::RosterStorage::SQLite::Fixed - a shared roster implementation for the SQLite roster storage

=head1 VERSION

Version 0.02
=cut

our $VERSION = '0.02';

=head1 SYNOPSIS

    <VHost mydomain.com>

	[...]

	<Plugin DJabberd::RosterStorage::SQLite::Fixed>
	    Database jabberroster.sqlite
	    FixedGuestOK yes
	</Plugin>
    </VHost>

Valid command are all command valid in DJabberd::RosterStorage::SQLite Plus the following

FixedGuestOK - Populate accounts with the shared roster if they are not in the roster itself?
 Setting this to yes will populate a user who is not in the shared roster with everyone in the shared roster
 The default is to only populate rosters for users that are part of the shared roster

=head1 AUTHOR

Edward Rudd, C<< <urkle at outoforder.cc> >>

=cut

=head2 set_config_fixedguestok($self, $guest)

Called to specify if guests should have the shared roster added to their roster

=cut

sub set_config_fixedguestok {
    my ($self, $guest) = @_;
    $self->{fixed_guestok} = as_bool $guest;
}

=head2 finalize($self)

Set defaults for the configuration

=cut

sub finalize {
    my $self = shift;
    $self->{fixed_guestok} = 0 unless $self->{fixed_guestok};
    $self->SUPER::finalize;
}

=head2 get_roster($self, $cb, $jid)

Gets the Roster for the user

=cut

sub get_roster {
    my ($self, $cb, $jid) = @_;
    # cb can '->set_roster(Roster)' or decline

    my $myself = lc $jid->as_bare_string;
    $logger->info("Fixed loading roster for $myself ...");

    my $on_load_roster = sub {
        my (undef, $roster) = @_;

        my $pre_ct = $roster->items;
        $logger->info("  $pre_ct roster items prior to population...");

        # see which shared contacts already in roster
        my %has;
        foreach my $it ($roster->items) {
            my $jid = $it->jid;
            $has{lc $jid->as_bare_string} = $it;
        }

        # add missing shared contacts to the roster
        my $req_roster = $self->_roster();
        if ($self->{fixed_guestok}==0) {
    	    my $guestok = 0;
    	    foreach my $user ( @$req_roster) {
    		if ($user->{jid} eq $myself) {
    		    $guestok = 1;
    		    last;
    		}
    	    }
    	    # Bail if guestOK == 0 && user it not in the roster
    	    return if $guestok == 0;
        }

        foreach my $user ( @$req_roster) {
            next if $user->{jid} eq $myself;

            my $name = $user->{name};
            my $ri = $has{$user->{jid}} || DJabberd::RosterItem->new(jid  => $user->{jid},
                                                             name => ($user->{name} || $user->{jid}),
                                                             groups => [$user->{group}]);


            $ri->subscription->set_from;
            $ri->subscription->set_to;
            $roster->add($ri);
        }

        my $post_ct = $roster->items;
        $logger->info("  $post_ct roster items post population...");

        $cb->set_roster($roster);
    };

    my $cb2 = DJabberd::Callback->new({set_roster => $on_load_roster,
                                      decline    => sub { $cb->decline }});
    $self->SUPER::get_roster($cb2, $jid);
}

=head2 check_install_schema($self)

Checks the SQL ite Schema

=cut

sub check_install_schema {
    my $self = shift;

    $self->SUPER::check_install_schema();

    my $dbh = $self->{dbh};

    eval {
        $dbh->do(qq{
            CREATE TABLE requiredusers (
        			 jid VARCHAR(255) NOT NULL,
        			 fullname VARCHAR(255) NOT NULL,
        			 groupname VARCHAR(255) NOT NULL,
                                 UNIQUE (jid)
                                 )});
    };
    if ($@ && $@ !~ /table \w+ already exists/) {
        $logger->logdie("SQL error $@");
        die "SQL error: $@\n";
    }
    eval {
	$dbh->do(qq{
	    CREATE VIEW RosterPreview AS
		SELECT ju.jid AS UserID, g.name AS [Group],
		    jr.jid AS ContactID, r.name AS Contact, r.subscription AS Subscription
	        FROM roster r
	            JOIN jidmap ju ON r.userid=ju.jidid
	            JOIN jidmap jr ON r.contactid = jr.jidid
                    JOIN groupitem gi ON gi.contactid=r.contactid
                    JOIN rostergroup g ON g.userid=r.userid AND g.groupid=gi.groupid
                    UNION SELECT r1.jid, r2.groupname, r2.jid, r2.fullname, 3
                    FROM requiredusers r1, requiredusers r2
                        WHERE r1.jid != r2.jid});
    };
    if ($@ && $@ !~ /table \w+ already exists/) {
	$logger->logdie("SQL error $@");
	die "SQL error: $@\n";
    }
    eval {
	$dbh->do(qq{
	    CREATE VIEW RosterList AS
		SELECT J.jidid as LID, J2.jidid as RID,
		    G.groupid as GID,
	            J.jid AS Local, J2.jid AS Remote,
	            G.name AS [Group]
                FROM jidmap J
                    JOIN rostergroup G ON G.userid=J.jidid
            	    JOIN groupitem M ON G.groupid = M.groupid
            	    JOIN jidmap J2 ON J2.jidid = M.contactid
            	ORDER BY J.jid, J2.jid});
    };
    if ($@ && $@ !~ /table \w+ already exists/) {
	$logger->logdie("SQL error $@");
	die "SQL error: $@\n";
    }
    $logger->info("Created all roster tables");
}

my $last_roster;
my $last_roster_time = 0;  # unixtime of last SQL suck
sub _roster {
    my $self = shift;
    my $now = time();

    # Cache list for 1 minute(s)
    if ($last_roster && $last_roster_time > $now - 60) {
        return $last_roster;
    }

    my $dbh = $self->{dbh};

    my $sql = qq{
	SELECT jid, fullname, groupname FROM requiredusers
    };

    my $roster = eval {
        $dbh->selectall_arrayref($sql);
    };
    $logger->logdie("Failed to load roster: $@") if $@;

    $logger->info("Found ".($#{ @$roster}+1)." Roster users");

    my @info = ();
    foreach my $item ( @$roster ) {
	my $rec = {};
	$rec->{'jid'} = $item->[0];
	$rec->{'name'} = $item->[1];
	$rec->{'group'} = $item->[2];
	push @info, $rec;
    }
    $logger->info("Loaded ".($#info+1)." Roster users");
    $last_roster_time = $now;
    return $last_roster = \@info;
}

=head2 load_roster_item($self, $jid, $contact_jid, $cb)

Called when a roster item is added

=cut

sub load_roster_item {
    my ($self, $jid, $contact_jid, $cb) = @_;

    my $is_shared = sub {
        my $jid = shift;
        my $roster = $self->_roster();
        foreach my $user (@$roster) {
    	    if (lc $user->{jid} eq lc $jid->as_bare_string) { return 1; }
        }
        return 0;
    };

    if ($is_shared->($jid) && $is_shared->($contact_jid)) {
        my $both = DJabberd::Subscription->new;
        $both->set_from;
        $both->set_to;
        my $rit = DJabberd::RosterItem->new(jid  => $contact_jid,
                                            subscription => $both);
        $cb->set($rit);
        return;
    }

    $self->SUPER::load_roster_item($jid, $contact_jid, $cb);
}

=head1 COPYRIGHT & LICENSE

Original work Copyright 2006 Alexander Karelas, Martin Atkins, Brad Fitzpatrick and Aleksandar Milanov. All rights reserved.
Copyright 2007 Edward Rudd. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;