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