perl/lib/Thrasher/Plugin/Vcard.pm

   1 package Thrasher::Plugin::Vcard;
   2 # The Perl module standard and the capitalization of vCard are in
   3 # conflict. I like Perl better. Perl wins!
   4
   5 use strict;
   6 use warnings;
   7
   8 =pod
   9
  10 =head1 NAME
  11
  12 Thrasher::Plugin::Vcard - implements vCard support for transport
  13 users, including avatar support.
  14
  15 =head1 DESCRIPTION
  16
  17 This module replies when a user's vcard is requested, filling in their
  18 avatar, and possibly other things. This module is intended to be
  19 filled out, as more things that can be stuck in vCards are
  20 implemented.
  21
  22 In the meantime, you get conventional avatars this way, including
  23 full XEP-0153 support for avatar hash advertising.
  24
  25 =cut
  26
  27 use Thrasher::Log qw(log);
  28 use Thrasher::Plugin qw(:all);
  29 use Thrasher::XML qw(strip_resource);
  30 use Thrasher::Constants qw(:all);
  31
  32 use Digest::SHA1 qw(sha1_hex);
  33 use Carp qw(confess);
  34 use Thrasher::Component qw(strip_resource);
  35
  36 # $user_jid -> $legacy_jid -> avatar sha1_hex
  37 my %AVATARS;
  38
  39 register_plugin({client_iq_handlers =>
  40                      {$NS_VCARD => { get => \&return_vcard }},
  41                  component_iq_handlers =>
  42                      {$NS_VCARD => { get => \&return_component_vcard}},
  43                  features => [$NS_VCARD, $NS_VCARD_UPDATE],
  44                  callbacks => {
  45                      presence_out => { vcard => \&presence_hook },
  46                      avatar_changed => { vcard => \&avatar_update }
  47                  }
  48                 });
  49
  50
  51 sub avatar_update {
  52     my $component = shift;
  53     my $user_jid = shift;
  54     my $legacy_jid = shift;
  55     my $raw_binary_data = shift;
  56     my $base64_data = shift;
  57     my $image = shift;
  58
  59     my $hash = sha1_hex($raw_binary_data);
  60     my $old_hash = $AVATARS{$user_jid}->{$legacy_jid};
  61     $AVATARS{$user_jid}->{$legacy_jid} = $hash;
  62
  63     if (!$old_hash || $hash ne $old_hash) {
  64         my $session = $component->session_for($user_jid);
  65         my $presence_info =
  66             $session->{component}->{presence}->{strip_resource($user_jid)}->{strip_resource($legacy_jid)};
  67         if (ref($presence_info) eq 'ARRAY') {
  68             my ($type, $show, $status) = @$presence_info;
  69             $component->send_presence_xml
  70                 ($user_jid, $type, $legacy_jid,
  71                  $show, $status);
  72         }
  73     }
  74 }
  75
  76 sub presence_hook {
  77     my $component = shift;
  78     my $presence_tag = shift;
  79
  80     my $component_name = $component->{component_name};
  81
  82     my $user_jid = $presence_tag->[1]->{to};
  83     my $legacy_jid = $presence_tag->[1]->{from};
  84
  85     if ($legacy_jid && $user_jid &&
  86         $legacy_jid =~ /$component_name$/) {
  87         my @children;
  88
  89         my $avatar_hash = $AVATARS{$user_jid}->{$legacy_jid};
  90         if ($avatar_hash) {
  91             push(@children, [[$NS_VCARD_UPDATE, 'photo'], {}, $avatar_hash]);
  92         }
  93
  94         if ($legacy_jid =~ /\@/) {
  95             my $legacy_name
  96               = $component->xmpp_name_to_legacy($user_jid, $legacy_jid);
  97             my $displayname
  98               = $component->{protocol}->get_displayname($user_jid,
  99                                                         $legacy_name);
 100             if ($displayname) {
 101                 push(@children, [[$NS_VCARD_UPDATE, 'fn'],
 102                                  {},
 103                                  [ $displayname ]]);
 104             }
 105         }
 106
 107         push(@{$presence_tag->[2]},
 108              [[$NS_VCARD_UPDATE, 'x'], {}, \@children]);
 109     }
 110
 111     return 1;
 112 }
 113
 114 sub return_component_vcard {
 115     my $component = shift;
 116     my $iq_params = shift;
 117     my $iq_tag = shift;
 118
 119     my $vcard = [[$NS_VCARD, 'vCard'], {},
 120                  [
 121                   [[$NS_VCARD, 'EMAIL'], {},
 122                    [[[$NS_VCARD, 'USERID'], {},
 123                      [$component->{component_name}]]]]]];
 124     $component->iq_reply($iq_params, $vcard);
 125 }
 126
 127 sub return_vcard {
 128     my $component = shift;
 129     my $iq_params = shift;
 130     my $iq_tag = shift;
 131
 132     my $vcard_target = strip_resource($iq_params->{to});
 133     my $request_from = strip_resource($iq_params->{from});
 134     my @vcard_elts;
 135
 136     my $avatar =
 137         $component->{protocol}->{backend}->get_avatar($request_from,
 138                                                       $vcard_target);
 139     if ($avatar) {
 140         push(@vcard_elts, [[$NS_VCARD, 'PHOTO'], {}, [
 141             [[$NS_VCARD, 'TYPE'], {}, ['image/png']],
 142             [[$NS_VCARD, 'BINVAL'], {}, [$avatar]],
 143         ]]);
 144     }
 145
 146     my $legacy_name = $component->xmpp_name_to_legacy($request_from,
 147                                                       $vcard_target);
 148     my $displayname = $component->{protocol}->get_displayname($request_from,
 149                                                               $legacy_name);
 150     if ($displayname) {
 151         push(@vcard_elts, [[$NS_VCARD, 'FN'], {}, [ $displayname ]]);
 152     }
 153
 154     my $vcard_xml = [[$NS_VCARD, 'vCard'], {}, \@vcard_elts];
 155     $component->iq_reply($iq_params, $vcard_xml);
 156 }
 157
 158 1;