;;; jabber-vcard-avatars.el --- Avatars by JEP-0153 ;; Copyright (C) 2006, 2007, 2008 Magnus Henoch ;; Author: Magnus Henoch ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;;; Code: (require 'jabber-avatar) (defcustom jabber-vcard-avatars-retrieve (and (fboundp 'display-images-p) (display-images-p)) "Automatically download vCard avatars?" :group 'jabber-avatar :type 'boolean) (defcustom jabber-vcard-avatars-publish t "Publish your vCard photo as avatar?" :group 'jabber-avatar :type 'boolean) (defvar jabber-vcard-avatars-current-hash (make-hash-table :test 'equal) "For each connection, SHA1 hash of current avatar. Keys are full JIDs.") (add-to-list 'jabber-presence-chain 'jabber-vcard-avatars-presence) (defun jabber-vcard-avatars-presence (jc xml-data) "Look for vCard avatar mark in stanza." ;; Only look at ordinary presence (when (and jabber-vcard-avatars-retrieve (null (jabber-xml-get-attribute xml-data 'type))) (let* ((from (jabber-jid-user (jabber-xml-get-attribute xml-data 'from))) (photo (jabber-xml-path xml-data '(("vcard-temp:x:update" . "x") photo))) (sha1-hash (car (jabber-xml-node-children photo)))) (cond ((null sha1-hash) ;; User has removed avatar (jabber-avatar-set from nil)) ((string= sha1-hash (get (jabber-jid-symbol from) 'avatar-hash)) ;; Same avatar as before; do nothing ) ((jabber-avatar-find-cached sha1-hash) ;; Avatar is cached (jabber-avatar-set from sha1-hash)) (t ;; Avatar is not cached; retrieve it (jabber-vcard-avatars-fetch jc from sha1-hash)))))) (defun jabber-vcard-avatars-fetch (jc who sha1-hash) "Fetch WHO's vCard, and extract avatar." (interactive (list (jabber-read-account) (jabber-read-jid-completing "Fetch whose vCard avatar: ") nil)) (jabber-send-iq jc who "get" '(vCard ((xmlns . "vcard-temp"))) #'jabber-vcard-avatars-vcard (cons who sha1-hash) #'ignore nil)) (defun jabber-vcard-avatars-vcard (jc iq closure) "Get the photo from the vCard, and set the avatar." (let ((from (car closure)) (sha1-hash (cdr closure)) (photo (assq 'PHOTO (jabber-vcard-parse (jabber-iq-query iq))))) (if photo (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo) (nth 1 photo)))) (unless (or (null sha1-hash) (string= sha1-hash (avatar-sha1-sum avatar))) (when jabber-avatar-verbose (message "%s's avatar should have SHA1 sum %s, but has %s" (jabber-jid-displayname from) sha1-hash (avatar-sha1-sum avatar)))) (jabber-avatar-cache avatar) (jabber-avatar-set from avatar)) (jabber-avatar-set from nil)))) (defun jabber-vcard-avatars-find-current (jc) "Request our own vCard, to find hash of avatar." (when jabber-vcard-avatars-publish (jabber-send-iq jc nil "get" '(vCard ((xmlns . "vcard-temp"))) #'jabber-vcard-avatars-find-current-1 t #'jabber-vcard-avatars-find-current-1 nil))) (defun jabber-vcard-avatars-find-current-1 (jc xml-data success) (jabber-vcard-avatars-update-current jc (and success (let ((photo (assq 'PHOTO (jabber-vcard-parse (jabber-iq-query xml-data))))) (when photo (let ((avatar (jabber-avatar-from-base64-string (nth 2 photo) (nth 1 photo)))) (avatar-sha1-sum avatar))))))) (defun jabber-vcard-avatars-update-current (jc new-hash) (let ((old-hash (gethash (jabber-connection-bare-jid jc) jabber-vcard-avatars-current-hash))) (when (not (string= old-hash new-hash)) (puthash (jabber-connection-bare-jid jc) new-hash jabber-vcard-avatars-current-hash) (jabber-send-current-presence jc)))) (add-to-list 'jabber-presence-element-functions 'jabber-vcard-avatars-presence-element) (defun jabber-vcard-avatars-presence-element (jc) (when jabber-vcard-avatars-publish (let ((hash (gethash (jabber-connection-bare-jid jc) jabber-vcard-avatars-current-hash))) (list `(x ((xmlns . "vcard-temp:x:update")) ;; if "not yet ready to advertise image", don't. ;; that is, we haven't yet checked what avatar we have. ,(when hash `(photo () ,hash))))))) (provide 'jabber-vcard-avatars) ;; arch-tag: 3e50d460-8eae-11da-826c-000a95c2fcd0