1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
|
;;; jabber-avatar.el --- generic functions for avatars
;; Copyright (C) 2006, 2007, 2008 Magnus Henoch
;; Author: Magnus Henoch <mange@freemail.hu>
;; 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:
;; There are several methods for transporting avatars in Jabber
;; (JEP-0008, JEP-0084, JEP-0153). They all have in common that they
;; identify avatars by their SHA1 checksum, and (at least partially)
;; use Base64-encoded image data. Thus this library of support
;; functions for interpreting and caching avatars.
;; A contact with an avatar has the image in the avatar property of
;; the JID symbol. Use `jabber-avatar-set' to set it.
;;; Code:
(require 'mailcap)
(eval-when-compile (require 'cl))
;;;; Variables
(defgroup jabber-avatar nil
"Avatar related settings"
:group 'jabber)
(defcustom jabber-avatar-cache-directory
(locate-user-emacs-file "jabber-avatar-cache" ".jabber-avatars")
"Directory to use for cached avatars"
:group 'jabber-avatar
:type 'directory)
(defcustom jabber-avatar-verbose nil
"Display messages about irregularities with other people's avatars."
:group 'jabber-avatar
:type 'boolean)
(defcustom jabber-avatar-max-width 96
"Maximum width of avatars."
:group 'jabber-avatar
:type 'integer)
(defcustom jabber-avatar-max-height 96
"Maximum height of avatars."
:group 'jabber-avatar
:type 'integer)
;;;; Avatar data handling
(defstruct avatar sha1-sum mime-type url base64-data height width bytes)
(defun jabber-avatar-from-url (url)
"Construct an avatar structure from the given URL.
Retrieves the image to find info about it."
(with-current-buffer (let ((coding-system-for-read 'binary))
(url-retrieve-synchronously url))
(let* ((case-fold-search t)
(mime-type (ignore-errors
(search-forward-regexp "^content-type:[ \t]*\\(.*\\)$")
(match-string 1)))
(data (progn
(search-forward "\n\n")
(buffer-substring (point) (point-max)))))
(prog1
(jabber-avatar-from-data data nil mime-type)
(kill-buffer nil)))))
(defun jabber-avatar-from-file (filename)
"Construct an avatar structure from FILENAME."
(require 'mailcap)
(let ((data (with-temp-buffer
(insert-file-contents-literally filename)
(buffer-string)))
(mime-type (when (string-match "\\.[^.]+$" filename)
(mailcap-extension-to-mime (match-string 0 filename)))))
(jabber-avatar-from-data data nil mime-type)))
(defun jabber-avatar-from-base64-string (base64-string &optional mime-type)
"Construct an avatar stucture from BASE64-STRING.
If MIME-TYPE is not specified, try to find it from the image data."
(jabber-avatar-from-data nil base64-string mime-type))
(defun jabber-avatar-from-data (raw-data base64-string &optional mime-type)
"Construct an avatar structure from RAW-DATA and/or BASE64-STRING.
If either is not provided, it is computed.
If MIME-TYPE is not specified, try to find it from the image data."
(let* ((data (or raw-data (base64-decode-string base64-string)))
(bytes (length data))
(sha1-sum (sha1 data))
(base64-data (or base64-string (base64-encode-string raw-data)))
(type (or mime-type
(cdr (assq (get :type (cdr (condition-case nil
(jabber-create-image data nil t)
(error nil))))
'((png "image/png")
(jpeg "image/jpeg")
(gif "image/gif")))))))
(jabber-avatar-compute-size
(make-avatar :mime-type mime-type :sha1-sum sha1-sum :base64-data base64-data :bytes bytes))))
;; XXX: This function is based on an outdated version of JEP-0084.
;; (defun jabber-avatar-from-data-node (data-node)
;; "Construct an avatar structure from the given <data/> node."
;; (jabber-xml-let-attributes
;; (content-type id bytes height width) data-node
;; (let ((base64-data (car (jabber-xml-node-children data-node))))
;; (make-avatar :mime-type content-type :sha1-sum id :bytes bytes
;; :height height :width width :base64-data base64-data))))
(defun jabber-avatar-image (avatar)
"Create an image from AVATAR.
Return nil if images of this type are not supported."
(condition-case nil
(jabber-create-image (with-temp-buffer
(set-buffer-multibyte nil)
(insert (avatar-base64-data avatar))
(base64-decode-region (point-min) (point-max))
(buffer-string))
nil
t)
(error nil)))
(defun jabber-avatar-compute-size (avatar)
"Compute and set the width and height fields of AVATAR.
Return AVATAR."
;; image-size only works when there is a window system.
;; But display-graphic-p doesn't exist on XEmacs...
(let ((size (and (fboundp 'display-graphic-p)
(display-graphic-p)
(let ((image (jabber-avatar-image avatar)))
(and image
(image-size image t))))))
(when size
(setf (avatar-width avatar) (car size))
(setf (avatar-height avatar) (cdr size)))
avatar))
;;;; Avatar cache
(defun jabber-avatar-find-cached (sha1-sum)
"Return file name of cached image for avatar identified by SHA1-SUM.
If there is no cached image, return nil."
(let ((filename (expand-file-name sha1-sum jabber-avatar-cache-directory)))
(if (file-exists-p filename)
filename
nil)))
(defun jabber-avatar-cache (avatar)
"Cache the AVATAR."
(let* ((id (avatar-sha1-sum avatar))
(base64-data (avatar-base64-data avatar))
(mime-type (avatar-mime-type avatar))
(filename (expand-file-name id jabber-avatar-cache-directory)))
(unless (file-directory-p jabber-avatar-cache-directory)
(make-directory jabber-avatar-cache-directory t))
(if (file-exists-p filename)
(when jabber-avatar-verbose
(message "Caching avatar, but %s already exists" filename))
(with-temp-buffer
(let ((require-final-newline nil)
(coding-system-for-write 'binary))
(if (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil))
(insert base64-data)
(base64-decode-region (point-min) (point-max))
(write-region (point-min) (point-max) filename nil 'silent))))))
;;;; Set avatar for contact
(defun jabber-avatar-set (jid avatar)
"Set the avatar of JID to be AVATAR.
JID is a string containing a bare JID.
AVATAR may be one of:
* An avatar structure.
* The SHA1 sum of a cached avatar.
* nil, meaning no avatar."
;; We want to optimize for the case of same avatar.
;; Loading an image is expensive, so do it lazily.
(let ((jid-symbol (jabber-jid-symbol jid))
image hash)
(cond
((avatar-p avatar)
(setq hash (avatar-sha1-sum avatar))
(setq image (lambda () (jabber-avatar-image avatar))))
((stringp avatar)
(setq hash avatar)
(setq image (lambda ()
(condition-case nil
(jabber-create-image (jabber-avatar-find-cached avatar))
(error nil)))))
(t
(setq hash nil)
(setq image #'ignore)))
(unless (string= hash (get jid-symbol 'avatar-hash))
(put jid-symbol 'avatar (funcall image))
(put jid-symbol 'avatar-hash hash)
(jabber-presence-update-roster jid-symbol))))
(defun jabber-create-image (file-or-data &optional type data-p)
"Create image, scaled down to jabber-avatar-max-width/height,
if width/height exceeds either of those, and ImageMagick is
available."
(let* ((image (create-image file-or-data type data-p))
(size (image-size image t))
(spec (cdr image)))
(when (and (functionp 'imagemagick-types)
(or (> (car size) jabber-avatar-max-width)
(> (cdr size) jabber-avatar-max-height)))
(plist-put spec :type 'imagemagick)
(plist-put spec :width jabber-avatar-max-width)
(plist-put spec :height jabber-avatar-max-height))
image))
(provide 'jabber-avatar)
;; arch-tag: 2405c3f8-8eaa-11da-826c-000a95c2fcd0
|
