1#  avatar.tcl --
2#
3#      This file is part of the jabberlib.
4#      It provides support for avatars (XEP-0008: IQ-Based Avatars)
5#      and vCard based avatars as XEP-0153.
6#      Note that this XEP is "historical" only but is easy to adapt to
7#      a future pub-sub method.
8#
9#  Copyright (c) 2005-2006  Mats Bengtsson
10#  Copyright (c) 2006 Antonio Cano Damas
11#
12# This file is distributed under BSD style license.
13#
14# $Id: avatar.tcl,v 1.27 2007-11-10 15:44:59 matben Exp $
15#
16############################# USAGE ############################################
17#
18#   NAME
19#      avatar - convenience command library for avatars.
20#
21#   SYNOPSIS
22#      jlib::avatar::init jlibname
23#
24#   OPTIONS
25#      -announce   0|1
26#      -share      0|1
27#      -command    tclProc      invoked when hash changed
28#      -cache      0|1
29#
30#   INSTANCE COMMANDS
31#      jlibName avatar configure ?-key value...?
32#      jlibName avatar set_data data mime
33#      jlibName avatar unset_data
34#      jlibName avatar store command
35#      jlibName avatar store_remove command
36#      jlibName avatar get_async jid command
37#      jlibName avatar send_get jid command
38#      jlibName avatar send_get_storage jid command
39#      jlibName avatar get_data jid2
40#      jlibName avatar get_hash jid2
41#      jlibName avatar get_mime jid2
42#      jlibName avatar have_data jid2
43#      jlibName avatar have_hash jid2
44#
45#   Note that all internal storage refers to bare (2-tier) JIDs!
46#   @@@ It is unclear if this is correct. Perhaps the full JIDs shall be used.
47#   The problem is with XEP-0008 mixing JID2 with JID3.
48#   Note that all vCards are defined per JID2, bare JID.
49#
50#   @@@ And what happens for groupchat members?
51#
52#   No automatic presence or server storage is made when reconfiguring or
53#   changing own avatar. This is up to the client layer to do.
54#   It is callback based which means that the -command is only invoked when
55#   getting hashes and not else.
56#
57################################################################################
58# TODO:
59#       1) Update to XEP-0084: User Avatar 1.0, 2007-11-07, using PEP
60
61package require base64     ; # tcllib
62package require sha1       ; # tcllib
63package require jlib
64package require jlib::disco
65package require jlib::vcard
66
67package provide jlib::avatar 0.1
68
69namespace eval jlib::avatar {
70    variable inited 0
71    variable xmlns
72    set xmlns(x-avatar)   "jabber:x:avatar"
73    set xmlns(iq-avatar)  "jabber:iq:avatar"
74    set xmlns(storage)    "storage:client:avatar"
75    set xmlns(vcard-temp) "vcard-temp:x:update"
76
77    jlib::ensamble_register avatar \
78      [namespace current]::init    \
79      [namespace current]::cmdproc
80
81    jlib::disco::registerfeature $xmlns(iq-avatar)
82
83    # Note: jlib::ensamble_register is last in this file!
84}
85
86proc jlib::avatar::init {jlibname args} {
87
88    variable xmlns
89
90    # Instance specific arrays:
91    #   avatar stores our own avatar
92    #   state stores other avatars
93    namespace eval ${jlibname}::avatar {
94	variable avatar
95	variable state
96	variable options
97    }
98    upvar ${jlibname}::avatar::avatar  avatar
99    upvar ${jlibname}::avatar::state   state
100    upvar ${jlibname}::avatar::options options
101
102    array set options {
103	-announce   0
104	-share      0
105	-cache      1
106	-command    ""
107    }
108    eval {configure $jlibname} $args
109
110    # Register some standard iq handlers that are handled internally.
111    $jlibname iq_register get $xmlns(iq-avatar) [namespace current]::iq_handler
112    $jlibname presence_register_int available  \
113      [namespace current]::presence_handler
114
115    $jlibname register_reset [namespace current]::reset
116
117    return
118}
119
120proc jlib::avatar::reset {jlibname} {
121    upvar ${jlibname}::avatar::state state
122    upvar ${jlibname}::avatar::options options
123
124    # Do not unset our own avatar.
125    if {!$options(-cache)} {
126	unset -nocomplain state
127    }
128}
129
130# jlib::avatar::cmdproc --
131#
132#       Just dispatches the command to the right procedure.
133#
134# Arguments:
135#       jlibname:   the instance of this jlib.
136#       cmd:
137#       args:       all args to the cmd procedure.
138#
139# Results:
140#       none.
141
142proc jlib::avatar::cmdproc {jlibname cmd args} {
143
144    # Which command? Just dispatch the command to the right procedure.
145    return [eval {$cmd $jlibname} $args]
146}
147
148proc jlib::avatar::configure {jlibname args} {
149
150    upvar ${jlibname}::avatar::options options
151
152    set opts [lsort [array names options -*]]
153    set usage [join $opts ", "]
154    if {[llength $args] == 0} {
155	set result {}
156	foreach name $opts {
157	    lappend result $name $options($name)
158	}
159	return $result
160    }
161    regsub -all -- - $opts {} opts
162    set pat ^-([join $opts |])$
163    if {[llength $args] == 1} {
164	set flag [lindex $args 0]
165	if {[regexp -- $pat $flag]} {
166	    return $options($flag)
167	} else {
168	    return -code error "Unknown option $flag, must be: $usage"
169	}
170    } else {
171	array set oldopts [array get options]
172	foreach {flag value} $args {
173	    if {[regexp -- $pat $flag]} {
174		set options($flag) $value
175	    } else {
176		return -code error "Unknown option $flag, must be: $usage"
177	    }
178	}
179	if {$options(-announce) != $oldopts(-announce)} {
180	    if {$options(-announce)} {
181		# @@@ ???
182	    } else {
183		$jlibname deregister_presence_stanza x $xmlns(x-avatar)
184                $jlibname deregister_presence_stanza x $xmlns(vcard-temp)
185	    }
186	}
187    }
188}
189
190#+++ Two sections: First part deals with our own avatar ------------------------
191
192# jlib::avatar::set_data --
193#
194#       Sets our own avatar data and shares it by default.
195#       Registers new hashes but does not send updated presence.
196#       You have to send presence yourself.
197#
198# Arguments:
199#       jlibname:   the instance of this jlib.
200#       data:       raw binary image data.
201#       mime:       the mime type: image/gif or image/png
202#
203# Results:
204#       none.
205
206proc jlib::avatar::set_data {jlibname data mime} {
207    variable xmlns
208    upvar ${jlibname}::avatar::avatar  avatar
209    upvar ${jlibname}::avatar::options options
210
211    set options(-announce) 1
212    set options(-share)    1
213
214    if {[info exists avatar(hash)]} {
215	set oldHash $avatar(hash)
216    } else {
217	set oldHash ""
218    }
219    set avatar(data)   $data
220    set avatar(mime)   $mime
221    set avatar(hash)   [::sha1::sha1 $data]
222    set avatar(base64) [::base64::encode $data]
223
224    set hashElem [wrapper::createtag hash -chdata $avatar(hash)]
225    set xElem [wrapper::createtag x           \
226      -attrlist [list xmlns $xmlns(x-avatar)] \
227      -subtags [list $hashElem]]
228
229    $jlibname deregister_presence_stanza x $xmlns(x-avatar)
230    $jlibname register_presence_stanza $xElem -type available
231
232    #-- vCard-temp presence stanza --
233    set photoElem [wrapper::createtag photo -chdata $avatar(hash)]
234    set xVCardElem [wrapper::createtag x         \
235      -attrlist [list xmlns $xmlns(vcard-temp)]  \
236      -subtags [list $photoElem]]
237
238    $jlibname deregister_presence_stanza x $xmlns(vcard-temp)
239    $jlibname register_presence_stanza $xVCardElem -type available
240
241    return
242}
243
244proc jlib::avatar::get_my_data {jlibname what} {
245    upvar ${jlibname}::avatar::avatar avatar
246
247    return $avatar($what)
248}
249
250# jlib::avatar::unset_data --
251#
252#       Unsets our avatar and does not share it anymore.
253#       You have to send presence yourself with empty hashes.
254
255proc jlib::avatar::unset_data {jlibname} {
256    variable xmlns
257    upvar ${jlibname}::avatar::avatar  avatar
258    upvar ${jlibname}::avatar::options options
259
260    unset -nocomplain avatar
261    set options(-announce) 0
262    set options(-share)    0
263
264    $jlibname deregister_presence_stanza x $xmlns(x-avatar)
265    $jlibname deregister_presence_stanza x $xmlns(vcard-temp)
266
267    return
268}
269
270# jlib::avatar::store --
271#
272#       Stores our avatar at the server.
273#       Must store as bare jid.
274
275proc jlib::avatar::store {jlibname cmd} {
276    variable xmlns
277    upvar ${jlibname}::avatar::avatar avatar
278
279    if {![array exists avatar]} {
280	return -code error "no avatar set"
281    }
282    set dataElem [wrapper::createtag data        \
283      -attrlist [list mimetype $avatar(mime)] \
284      -chdata $avatar(base64)]
285
286    set jid2 [$jlibname getthis myjid2]
287    $jlibname iq_set $xmlns(storage)  \
288      -to $jid2 -command $cmd -sublists [list $dataElem]
289}
290
291proc jlib::avatar::store_remove {jlibname cmd} {
292    variable xmlns
293
294    set jid2 [$jlibname getthis myjid2]
295    $jlibname iq_set $xmlns(storage) -to $jid2 -command $cmd
296}
297
298# jlib::avatar::iq_handler --
299#
300#       Handles incoming iq requests for our avatar.
301
302proc jlib::avatar::iq_handler {jlibname from queryElem args} {
303    variable xmlns
304    upvar ${jlibname}::avatar::options options
305    upvar ${jlibname}::avatar::avatar  avatar
306
307    array set argsArr $args
308    if {[info exists argsArr(-xmldata)]} {
309	set xmldata $argsArr(-xmldata)
310	set from [wrapper::getattribute $xmldata from]
311	set id   [wrapper::getattribute $xmldata id]
312    } else {
313	return 0
314    }
315
316    if {$options(-share)} {
317	set dataElem [wrapper::createtag data    \
318	  -attrlist [list mimetype $avatar(mime)] \
319	  -chdata $avatar(base64)]
320	set qElem [wrapper::createtag query  \
321	  -attrlist [list xmlns $xmlns(iq-avatar)]  \
322	  -subtags [list $dataElem]]
323	$jlibname send_iq result [list $qElem] -to $from -id $id
324	return 1
325    } else {
326	$jlibname send_iq_error $from $id 404 cancel service-unavailable
327	return 1
328    }
329}
330
331#+++ Second part deals with getting other avatars ------------------------------
332
333proc jlib::avatar::get_data {jlibname jid2} {
334    upvar ${jlibname}::avatar::state state
335
336    set mjid2 [jlib::jidmap $jid2]
337    if {[info exists state($mjid2,data)]} {
338	return $state($mjid2,data)
339    } else {
340	return ""
341    }
342}
343
344proc jlib::avatar::get_mime {jlibname jid2} {
345    upvar ${jlibname}::avatar::state state
346
347    set mjid2 [jlib::jidmap $jid2]
348    if {[info exists state($mjid2,mime)]} {
349	return $state($mjid2,mime)
350    } else {
351	return ""
352    }
353}
354
355proc jlib::avatar::have_data {jlibname jid2} {
356    upvar ${jlibname}::avatar::state state
357
358    set mjid2 [jlib::jidmap $jid2]
359    return [info exists state($mjid2,data)]
360}
361
362proc jlib::avatar::get_hash {jlibname jid2} {
363    upvar ${jlibname}::avatar::state state
364
365    set mjid2 [jlib::jidmap $jid2]
366    if {[info exists state($mjid2,hash)]} {
367	return $state($mjid2,hash)
368    } else {
369	return ""
370    }
371}
372
373proc jlib::avatar::have_hash {jlibname jid2} {
374    upvar ${jlibname}::avatar::state state
375
376    set mjid2 [jlib::jidmap $jid2]
377    return [info exists state($mjid2,hash)]
378}
379
380proc jlib::avatar::have_hash_protocol {jlibname jid2 protocol} {
381    upvar ${jlibname}::avatar::state state
382
383    set mjid2 [jlib::jidmap $jid2]
384    return [info exists state($mjid2,protocol,$protocol)]
385}
386
387proc jlib::avatar::get_protocols {jlibname jid2} {
388    upvar ${jlibname}::avatar::state state
389
390    set protocols {}
391    set mjid2 [jlib::jidmap $jid2]
392    foreach p {avatar vcard} {
393	if {[info exists state($mjid2,protocol,$p)]} {
394	    lappend protocols $p
395	}
396    }
397    return $protocols
398}
399
400# jlib::avatar::get_full_jid --
401#
402#       This is the jid3 associated with 'avatar' or jid2 if 'vcard',
403#       else we just return the jid2.
404
405proc jlib::avatar::get_full_jid {jlibname jid2} {
406    upvar ${jlibname}::avatar::state state
407
408    set mjid2 [jlib::jidmap $jid2]
409    if {[info exists state($mjid2,jid3)]} {
410	return $state($mjid2,jid3)
411    } else {
412	return $jid2
413    }
414}
415
416# jlib::avatar::get_all_avatar_jids --
417#
418#       Gets a list of all jids with avatar support.
419#       Actually, everyone that has sent us a presence jabber:x:avatar element.
420
421proc jlib::avatar::get_all_avatar_jids {jlibname} {
422    upvar ${jlibname}::avatar::state state
423
424    debug "jlib::avatar::get_all_avatar_jids"
425
426    set jids {}
427    set len [string length ",hash"]
428    foreach {key hash} [array get state *,hash] {
429	if {$hash ne ""} {
430	    set jid2 [string range $key 0 end-$len]
431	    lappend jids $jid2
432	}
433    }
434    return $jids
435}
436
437proc jlib::avatar::uptodate {jlibname jid2} {
438    upvar ${jlibname}::avatar::state state
439
440    set mjid2 [jlib::jidmap $jid2]
441    if {[info exists state($mjid2,uptodate)]} {
442	return $state($mjid2,uptodate)
443    } else {
444	return 0
445    }
446}
447
448# jlib::avatar::presence_handler --
449#
450#       We must handle both 'avatar' and 'vcard' from one place
451#       since we don't want separate callbacks if both are supplied.
452#       It is assumed that hash from any are identical.
453#       Invokes any -command if hash changed.
454
455proc jlib::avatar::presence_handler {jlibname xmldata} {
456    upvar ${jlibname}::avatar::options options
457    upvar ${jlibname}::avatar::state   state
458
459    set from [wrapper::getattribute $xmldata from]
460    set mjid [jlib::jidmap $from]
461    set mjid2 [jlib::barejid $mjid]
462
463    if {[info exists state($mjid2,hash)]} {
464	set new 0
465	set oldhash $state($mjid2,hash)
466    } else {
467	set new 1
468    }
469    set gotAvaHash [PresenceAvatar $jlibname $xmldata]
470    set gotVcardHash [PresenceVCard $jlibname $xmldata]
471
472    if {($gotAvaHash || $gotVcardHash)} {
473
474	# 'uptodate' tells us if we need to request new avatar.
475	# If new, or not identical to previous, unless empty.
476	if {$new || ($state($mjid2,hash) ne $oldhash)} {
477	    set hash $state($mjid2,hash)
478
479	    # hash can be empty.
480	    if {$hash eq ""} {
481		set state($mjid2,uptodate) 1
482		unset -nocomplain state($mjid2,data)
483	    } else {
484		set state($mjid2,uptodate) 0
485	    }
486	    if {[string length $options(-command)]} {
487		uplevel #0 $options(-command) [list $from]
488	    }
489	}
490    } else {
491
492	# Must be sure that nothing there.
493	if {[info exists state($mjid2,hash)]} {
494	    array unset state [jlib::ESC $mjid2],*
495	}
496    }
497}
498
499# jlib::avatar::PresenceAvatar --
500#
501#       Caches incoming <x xmlns='jabber:x:avatar'> presence elements.
502#       "To disable the avatar, the avatar-generating user's client will send
503#        a presence packet with the jabber:x:avatar namespace but with no hash
504#        information"
505
506proc jlib::avatar::PresenceAvatar {jlibname xmldata} {
507    variable xmlns
508    upvar ${jlibname}::avatar::state   state
509
510    set gotHash 0
511    set elems [wrapper::getchildswithtagandxmlns $xmldata x $xmlns(x-avatar)]
512    if {[llength $elems]} {
513	set hashElem [wrapper::getfirstchildwithtag [lindex $elems 0] hash]
514	set hash [wrapper::getcdata $hashElem]
515	set from [wrapper::getattribute $xmldata from]
516	set mjid2 [jlib::jidmap [jlib::barejid $from]]
517
518	# hash can be empty.
519	set state($mjid2,hash) $hash
520	set state($mjid2,jid3) $from
521	set state($mjid2,protocol,avatar) 1
522	set gotHash 1
523    }
524    return $gotHash
525}
526
527proc jlib::avatar::PresenceVCard {jlibname xmldata} {
528    variable xmlns
529    upvar ${jlibname}::avatar::state   state
530
531    set gotHash 0
532    set elems [wrapper::getchildswithtagandxmlns $xmldata x $xmlns(vcard-temp)]
533    if {[llength $elems]} {
534	set hashElem [wrapper::getfirstchildwithtag [lindex $elems 0] photo]
535	set hash [wrapper::getcdata $hashElem]
536	set from [wrapper::getattribute $xmldata from]
537	set mjid2 [jlib::jidmap [jlib::barejid $from]]
538
539	# Note that all vCards are defined per jid2, bare JID.
540	set state($mjid2,hash) $hash
541	set state($mjid2,jid3) $from
542	set state($mjid2,protocol,vcard) 1
543	set gotHash 1
544    }
545    return $gotHash
546}
547
548# jlib::avatar::get_async --
549#
550#       The economical way of obtaining a users avatar.
551#       If uptodate no query made, else it sends at most one query per user
552#       to get the avatar.
553
554proc jlib::avatar::get_async {jlibname jid cmd} {
555    upvar ${jlibname}::avatar::state state
556
557    set mjid2 [jlib::jidmap [jlib::barejid $jid]]
558    if {[uptodate $jlibname $mjid2]} {
559	uplevel #0 $cmd [list result $mjid2]
560    } elseif {[info exists state($mjid2,pending)]} {
561	lappend state($mjid2,invoke) $cmd
562    } else {
563	send_get $jlibname $jid  \
564	  [list [namespace current]::get_async_cb $jlibname $mjid2 $cmd]
565    }
566}
567
568proc jlib::avatar::get_async_cb {jlibname jid2 cmd type subiq args} {
569    upvar ${jlibname}::avatar::state state
570
571    uplevel #0 $cmd [list $type $jid2]
572}
573
574# jlib::avatar::send_get --
575#
576#       Initiates a request for avatar to the full jid.
577#       If fails we try to get avatar from server storage of the bare jid.
578
579proc jlib::avatar::send_get {jlibname jid cmd} {
580    variable xmlns
581    upvar ${jlibname}::avatar::state state
582
583    debug "jlib::avatar::send_get jid=$jid"
584
585    set mjid2 [jlib::jidmap [jlib::barejid $jid]]
586    set state($mjid2,pending) 1
587    $jlibname iq_get $xmlns(iq-avatar) -to $jid  \
588      -command [list [namespace current]::send_get_cb $jid $cmd]
589}
590
591proc jlib::avatar::send_get_cb {jid cmd jlibname type subiq args} {
592    variable xmlns
593    upvar ${jlibname}::avatar::state state
594
595    debug "jlib::avatar::send_get_cb jid=$jid"
596
597    set jid2  [jlib::barejid $jid]
598    set mjid2 [jlib::jidmap $jid2]
599    unset -nocomplain state($mjid2,pending)
600
601    if {$type eq "error"} {
602
603	# XEP-0008: "If the first method fails, the second method that should
604	# be attempted by sending a request to the server..."
605	send_get_storage $jlibname $mjid2 $cmd
606    } elseif {$type eq "result"} {
607	set ok [SetDataFromQueryElem $jlibname $mjid2 $subiq $xmlns(iq-avatar)]
608	InvokeStacked $jlibname $type $jid2
609	uplevel #0 $cmd [list $type $subiq] $args
610    }
611}
612
613# jlib::avatar::SetDataFromQueryElem --
614#
615#       Extracts and sets internal avtar storage for the BARE jid
616#       from a query element.
617#
618# Results:
619#       1 if there was data to store, 0 else.
620
621proc jlib::avatar::SetDataFromQueryElem {jlibname mjid2 queryElem ns} {
622    upvar ${jlibname}::avatar::state state
623
624    # Data may be empty from xmlns='storage:client:avatar' !
625
626    set ans 0
627    if {[wrapper::getattribute $queryElem xmlns] eq $ns} {
628	set dataElem [wrapper::getfirstchildwithtag $queryElem data]
629	if {$dataElem ne {}} {
630
631	    # Mime type can be empty.
632	    set state($mjid2,mime) [wrapper::getattribute $dataElem mimetype]
633
634	    # We keep data in base64 format. This seems to be ok for image
635	    # handlers.
636	    set data [wrapper::getcdata $dataElem]
637	    if {[string length $data]} {
638		set state($mjid2,data) $data
639		set state($mjid2,uptodate) 1
640		set ans 1
641	    }
642	}
643    }
644    return $ans
645}
646
647proc jlib::avatar::send_get_storage {jlibname jid2 cmd} {
648    variable xmlns
649    upvar ${jlibname}::avatar::state state
650
651    debug "jlib::avatar::send_get_storage jid2=$jid2"
652
653    set mjid2 [jlib::jidmap $jid2]
654    set state($mjid2,pending) 1
655    $jlibname iq_get $xmlns(storage) -to $jid2  \
656      -command [list [namespace current]::send_get_storage_cb $jid2 $cmd]
657}
658
659proc jlib::avatar::send_get_storage_cb {jid2 cmd jlibname type subiq args} {
660    variable xmlns
661    upvar ${jlibname}::avatar::state state
662
663    debug "jlib::avatar::send_get_storage_cb type=$type"
664
665    set mjid2 [jlib::jidmap $jid2]
666    unset -nocomplain state($mjid2,pending)
667    if {$type eq "result"} {
668	set ok [SetDataFromQueryElem $jlibname $mjid2 $subiq $xmlns(storage)]
669    }
670    InvokeStacked $jlibname $type $jid2
671    uplevel #0 $cmd [list $type $subiq] $args
672}
673
674proc jlib::avatar::InvokeStacked {jlibname type jid2} {
675    upvar ${jlibname}::avatar::state state
676
677    set mjid2 [jlib::jidmap $jid2]
678    if {[info exists state($jid2,invoke)]} {
679	foreach cmd $state($jid2,invoke) {
680	    uplevel #0 $cmd [list $type $jid2]
681	}
682	unset -nocomplain state($jid2,invoke)
683    }
684}
685
686#--- vCard support -------------------------------------------------------------
687
688proc jlib::avatar::get_vcard_async {jlibname jid2 cmd} {
689    upvar ${jlibname}::avatar::state state
690
691    debug "jlib::avatar::get_vcard_async jid=$jid2"
692
693    set mjid2 [jlib::jidmap $jid2]
694    if {[uptodate $jlibname $mjid2]} {
695	uplevel #0 $cmd [list result $jid2]
696    } else {
697
698	# Need to clear vcard cache to trigger sending a request.
699	# The photo is anyway not up-to-date.
700	$jlibname vcard clear $jid2
701	$jlibname vcard get_async $jid2  \
702	  [list [namespace current]::get_vcard_async_cb $jid2 $cmd]
703    }
704}
705
706proc jlib::avatar::get_vcard_async_cb {jid2 cmd jlibname type subiq args} {
707
708    debug "jlib::avatar::get_vcard_async_cb jid=$jid2"
709
710    if {$type eq "result"} {
711	set mjid2 [jlib::jidmap $jid2]
712	SetDataFromVCardElem $jlibname $mjid2 $subiq
713    }
714    uplevel #0 $cmd [list $type $jid2]
715}
716
717# jlib::avatar::send_get_vcard --
718#
719#       Support for vCard based avatars as XEP-0153.
720#       We must get vcard avatars from here since the result shall be cached.
721#       Note that all vCards are defined per jid2, bare JID.
722#       This method is more sane compared to iq-based avatars since it is
723#       based on bare jids and thus not client instance specific.
724#       Therefore it also handles offline users.
725
726proc jlib::avatar::send_get_vcard {jlibname jid2 cmd} {
727
728    debug "jlib::avatar::send_get_vcard jid2=$jid2"
729
730    $jlibname vcard send_get $jid2  \
731      -command [list [namespace current]::send_get_vcard_cb $jid2 $cmd]
732}
733
734proc jlib::avatar::send_get_vcard_cb {jid2 cmd jlibname type subiq args} {
735
736    debug "jlib::avatar::send_get_vcard_cb"
737
738    if { $type eq "result" } {
739	set mjid2 [jlib::jidmap $jid2]
740	SetDataFromVCardElem $jlibname $mjid2 $subiq
741	uplevel #0 $cmd [list $type $subiq] $args
742    }
743}
744
745# jlib::avatar::SetDataFromVCardElem --
746#
747#       Extracts and sets internal avtar storage for the BARE jid
748#       from a vcard element.
749#
750# Results:
751#       1 if there was data to store, 0 else.
752
753proc jlib::avatar::SetDataFromVCardElem {jlibname mjid2 subiq} {
754    upvar ${jlibname}::avatar::state state
755
756    set ans 0
757    set photoElem [wrapper::getfirstchildwithtag $subiq PHOTO]
758    if {$photoElem ne {}} {
759	set dataElem [wrapper::getfirstchildwithtag $photoElem BINVAL]
760	set mimeElem [wrapper::getfirstchildwithtag $photoElem TYPE]
761	if {$dataElem ne {}} {
762
763	    # We keep data in base64 format. This seems to be ok for image
764	    # handlers.
765	    set state($mjid2,data) [wrapper::getcdata $dataElem]
766	    set state($mjid2,mime) [wrapper::getcdata $mimeElem]
767	    set state($mjid2,uptodate) 1
768	    set ans 1
769	}
770    }
771    return $ans
772}
773
774proc jlib::avatar::debug {msg} {
775    if {0} {
776	puts "\t $msg"
777    }
778}
779
780# We have to do it here since need the initProc before doing this.
781
782namespace eval jlib::avatar {
783
784    jlib::ensamble_register avatar \
785      [namespace current]::init    \
786      [namespace current]::cmdproc
787}
788
789if {0} {
790    # Test.
791    set f "/Users/matben/Desktop/glaze/32x32/apps/clanbomber.png"
792    set fd [open $f]
793    fconfigure $fd -translation binary
794    set data [read $fd]
795    close $fd
796
797    set data "0123456789"
798
799    set jlib jlib::jlib1
800    proc cb {args} {puts "--- cb"}
801    $jlib avatar set_data $data image/png
802    $jlib avatar store cb
803    $jlib avatar send_get [$jlib getthis myjid] cb
804    $jlib avatar send_get_storage [$jlib getthis myjid2] cb
805}
806
807#-------------------------------------------------------------------------------
808