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. 44Keys 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 138