jabber-vcard-avatars.el

   1 ;;; jabber-vcard-avatars.el --- Avatars by JEP-0153
   2
   3 ;; Copyright (C) 2006, 2007, 2008  Magnus Henoch
   4
   5 ;; Author: Magnus Henoch <mange@freemail.hu>
   6
   7 ;; This file is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; This file is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;;
  25
  26 ;;; Code:
  27
  28 (require 'jabber-avatar)
  29
  30 (defcustom jabber-vcard-avatars-retrieve (and (fboundp 'display-images-p)
  31                                               (display-images-p))
  32   "Automatically download vCard avatars?"
  33   :group 'jabber-avatar
  34   :type 'boolean)
  35
  36 (defcustom jabber-vcard-avatars-publish t
  37   "Publish your vCard photo as avatar?"
  38   :group 'jabber-avatar
  39   :type 'boolean)
  40
  41 (defvar jabber-vcard-avatars-current-hash
  42   (make-hash-table :test 'equal)
  43   "For each connection, SHA1 hash of current avatar.
  44 Keys are full JIDs.")
  45
  46 (add-to-list 'jabber-presence-chain 'jabber-vcard-avatars-presence)
  47 (defun jabber-vcard-avatars-presence (jc xml-data)
  48   "Look for vCard avatar mark in <presence/> stanza."
  49   ;; Only look at ordinary presence
  50   (when (and jabber-vcard-avatars-retrieve
  51              (null (jabber-xml-get-attribute xml-data 'type)))
  52     (let* ((from (jabber-jid-user (jabber-xml-get-attribute xml-data 'from)))
  53            (photo (jabber-xml-path xml-data '(("vcard-temp:x:update" . "x") photo)))
  54            (sha1-hash (car (jabber-xml-node-children photo))))
  55       (cond
  56        ((null sha1-hash)
  57         ;; User has removed avatar
  58         (jabber-avatar-set from nil))
  59        ((string= sha1-hash (get (jabber-jid-symbol from) 'avatar-hash))
  60         ;; Same avatar as before; do nothing
  61         )
  62        ((jabber-avatar-find-cached sha1-hash)
  63         ;; Avatar is cached
  64         (jabber-avatar-set from sha1-hash))
  65        (t
  66         ;; Avatar is not cached; retrieve it
  67         (jabber-vcard-avatars-fetch jc from sha1-hash))))))
  68
  69 (defun jabber-vcard-avatars-fetch (jc who sha1-hash)
  70   "Fetch WHO's vCard, and extract avatar."
  71   (interactive (list (jabber-read-account)
  72                      (jabber-read-jid-completing "Fetch whose vCard avatar: ")
  73                      nil))
  74   (jabber-send-iq jc who "get" '(vCard ((xmlns . "vcard-temp")))
  75                   #'jabber-vcard-avatars-vcard (cons who sha1-hash)
  76                   #'ignore nil))
  77
  78 (defun jabber-vcard-avatars-vcard (jc iq closure)
  79   "Get the photo from the vCard, and set the avatar."
  80   (let ((from (car closure))
  81         (sha1-hash (cdr closure))
  82         (photo (assq 'PHOTO (jabber-vcard-parse (jabber-iq-query iq)))))
  83     (if photo
  84         (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo)
  85                                                         (nth 1 photo))))
  86           (unless (or (null sha1-hash)
  87                       (string= sha1-hash (avatar-sha1-sum avatar)))
  88             (when jabber-avatar-verbose
  89               (message "%s's avatar should have SHA1 sum %s, but has %s"
  90                        (jabber-jid-displayname from)
  91                        sha1-hash
  92                        (avatar-sha1-sum avatar))))
  93           (jabber-avatar-cache avatar)
  94           (jabber-avatar-set from avatar))
  95       (jabber-avatar-set from nil))))
  96
  97 (defun jabber-vcard-avatars-find-current (jc)
  98   "Request our own vCard, to find hash of avatar."
  99   (when jabber-vcard-avatars-publish
 100     (jabber-send-iq jc nil "get" '(vCard ((xmlns . "vcard-temp")))
 101                     #'jabber-vcard-avatars-find-current-1 t
 102                     #'jabber-vcard-avatars-find-current-1 nil)))
 103
 104 (defun jabber-vcard-avatars-find-current-1 (jc xml-data success)
 105   (jabber-vcard-avatars-update-current
 106    jc
 107    (and success
 108         (let ((photo (assq 'PHOTO (jabber-vcard-parse (jabber-iq-query xml-data)))))
 109           (when photo
 110             (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo)
 111                                                             (nth 1 photo))))
 112               (avatar-sha1-sum avatar)))))))
 113
 114 (defun jabber-vcard-avatars-update-current (jc new-hash)
 115   (let ((old-hash (gethash
 116                    (jabber-connection-bare-jid jc)
 117                    jabber-vcard-avatars-current-hash)))
 118     (when (not (string= old-hash new-hash))
 119       (puthash (jabber-connection-bare-jid jc)
 120                new-hash jabber-vcard-avatars-current-hash)
 121       (jabber-send-current-presence jc))))
 122
 123 (add-to-list 'jabber-presence-element-functions 'jabber-vcard-avatars-presence-element)
 124 (defun jabber-vcard-avatars-presence-element (jc)
 125   (when jabber-vcard-avatars-publish
 126     (let ((hash (gethash
 127                  (jabber-connection-bare-jid jc)
 128                  jabber-vcard-avatars-current-hash)))
 129       (list
 130        `(x ((xmlns . "vcard-temp:x:update"))
 131            ;; if "not yet ready to advertise image", don't.
 132            ;; that is, we haven't yet checked what avatar we have.
 133            ,(when hash
 134               `(photo () ,hash)))))))
 135
 136 (provide 'jabber-vcard-avatars)
 137 ;; arch-tag: 3e50d460-8eae-11da-826c-000a95c2fcd0