Tkabber

Changes On Branch xml-import-export
Login
Home Timeline Branches Tags Tickets Wiki
Patch Side-by-Side Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch xml-import-export Excluding Merge-Ins

This is equivalent to a diff from 7160cbf09f to 4a97a95379

2008-02-05
19:19
* doc/tkabber.html, doc/tkabber.xml, README: Fixed notice about external XML parser (replaced TclXML which diesnt' work by tDOM which works). * jabberlib/jabberlib.tcl: Eliminate use_external_tclxml variable. Now, to use tDOM a user should 'require' it in a config file. * chats.tcl, custom.tcl, datagathering.tcl, disco.tcl, ifaceck/iroster.tcl, messages.tcl, muc.tcl, plugins/chat/chatstate.tcl, plugins/chat/events.tcl, plugins/chat/histool.tcl, plugins/chat/logger.tcl, plugins/chat/nick_colors.tcl, plugins/general/headlines.tcl, plugins/general/message_archive.tcl, plugins/general/offline.tcl, plugins/general/rawxml.tcl, plugins/general/xcommands.tcl, plugins/roster/annotations.tcl, pubsub.tcl, register.tcl, search.tcl, userinfo.tcl: Removed usage of global variable font. check-in: 275916e5cd user: sgolovan tags: trunk
2008-02-02
14:43
Copied http://svn.xmpp.ru/repos/tkabber/branches/xml-import-export branch to http://svn.xmpp.ru/repos/tkabber/branches/xml-import-export-serialized to try out ideas implementing proper sequence of roster restoration actions which should ensure proper restoration independent of the XML file layout. check-in: 2c68e3af56 user: khomoutov tags: xml-import-export-serialized
14:27
roster/backup.tcl: Fixed a bug triggered on retrieving the roster items upon connecting. Closed-Leaf check-in: 4a97a95379 user: khomoutov tags: xml-import-export
02:08
roster/backup.tcl: Implemented synchronous sending of roster contacts to the server (in one piece). This ensures that the roster is populated with contacts before sending out annotations. roster/TODO: Tasks updated. check-in: ec8be1be46 user: khomoutov tags: xml-import-export
2008-01-27
23:43
Copied trunk HEAD at rev 1351 to the "xml-import-export" branch. This branch intended to keep the implementation of roster import/export in proper XML format with correct handling of conference bookmarks. check-in: 1c345640e2 user: khomoutov tags: xml-import-export
16:32
* plugins/filetransfer/si.tcl: Registered filetransfer feature to include it into disco#info replies. check-in: 7160cbf09f user: sgolovan tags: trunk
2008-01-23
20:20
* msgs/de.msg: Updated German translation (thanks to Roger Sondermann). check-in: b05c933a6f user: sgolovan tags: trunk

Changes to ifacetk/iroster.tcl.
︙
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952

1902
1903
1904
1905
1906
1907
1908





































1909
1910
1911
1912
1913
1914
1915








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    grid $p.lregexp    -row 1 -column 0 -sticky e
    grid $p.regexp     -row 1 -column 1 -sticky ew

    focus $p.groupname
    $w draw
}

###############################################################################

proc roster::setup_import_export_menus {args} {
    set emenu [.mainframe getmenu export_roster]
    set imenu [.mainframe getmenu import_roster]

    if {[winfo exists $emenu]} {
	destroy $emenu
    }
    menu $emenu -tearoff 0

    if {[winfo exists $imenu]} {
	destroy $imenu
    }
    menu $imenu -tearoff 0

    if {[jlib::connections] == {}} {
	.mainframe setmenustate export_roster disabled
	.mainframe setmenustate import_roster disabled
    } else {
	.mainframe setmenustate export_roster normal
	.mainframe setmenustate import_roster normal
    }

    foreach c [jlib::connections] {
	set jid [jlib::connection_jid $c]
	set label [format [::msgcat::mc "Roster of %s"] $jid]
	set ecommand [list roster::export_to_file $c]
	set icommand [list roster::import_from_file $c]
	$emenu add command -label $label -command $ecommand
	$imenu add command -label $label -command $icommand
    }
}
hook::add connected_hook [namespace current]::roster::setup_import_export_menus
hook::add disconnected_hook [namespace current]::roster::setup_import_export_menus
hook::add finload_hook [namespace current]::roster::setup_import_export_menus

###############################################################################

proc roster::add_group_custom_presence_menu {m connid name} {
    set mm [menu $m.custom_presence -tearoff 0]

    $mm add command -label [::msgcat::mc "Available"] \
	-command [list roster::send_custom_presence_group $connid $name available]
︙
Changes to jabberlib/wrapper.tcl.
︙
219
220
221
222
223
224
225
226
















227
228
229
230


231
232
233



234
235
236
237
238
239
240
241
242
243
244


245

246

247

248
249
250
251
252
253









254
255


256
257



258

259
260
261
262
263
264
265

219
220
221
222
223
224
225

226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243


244
245



246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

262
263
264
265
266






267
268
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292








-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
-
-
-
+
+
+











+
+
-
+

+

+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+
+


+
+
+

+








			\x1C " " \x1D " " \x1E " " \x1F " "} $text]
}

######################################################################
#
# This procedure converts (and returns) $xmldata to raw-XML
#
proc wrapper:createxml {xmldata {xmlns jabber:client}} {
proc wrapper:createxml {xmldata args} {
    set xmlns jabber:client
    set prettyprint 0
    set level 0
    foreach {opt val} $args {
	switch -- $opt {
	    -xmlns { set xmlns $val }
	    -level { set level $val }
	    -prettyprint { set prettyprint $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be one of -xmlns, -level or -prettyprint"
	    }
	}
    }

    set retext ""

    set tagname [lindex $xmldata 0]
    set vars    [lindex $xmldata 1]
    lassign $xmldata tagname vars subtags chdata

    set subtags [lindex $xmldata 2]
    set chdata  [lindex $xmldata 3]

    if {$prettyprint && $level} {
	append retext [string repeat \t $level]
    }
    append retext "<$tagname"
    foreach {attr value} $vars {
	if {$attr == "xmlns"} {
	    if {$value == $xmlns} {
		continue
	    } else {
		set xmlns $value
	    }
	}
	append retext " $attr='[wrapper:xmlcrypt $value]'"
    }

    set no_chdata [expr {$chdata == ""}]
    if {$chdata == "" && [llength $subtags] == 0} {
    if {$no_chdata && [llength $subtags] == 0} {
	append retext "/>"
	if {$prettyprint} { append retext \n }
	return $retext
    }
    } else {
	append retext ">"
    }

    append retext [wrapper:xmlcrypt $chdata]


    append retext ">"

    if {!$no_chdata} {
	append retext [wrapper:xmlcrypt $chdata]
    } elseif {$prettyprint} {
	append retext \n
    }

    foreach subdata $subtags {
	append retext [wrapper:createxml $subdata $xmlns]
	append retext [wrapper:createxml $subdata -xmlns $xmlns \
	    -prettyprint $prettyprint -level [expr {$level + 1}]]
    }

    if {$prettyprint && $no_chdata && $level} {
	append retext [string repeat \t $level]
    }
    append retext "</$tagname>"
    if {$prettyprint && $level} { append retext \n }

    return $retext
}

######################################################################
#
# This proc creates (and returns) xmldata of tag $tagname,
︙
386
387
388
389
390
391
392


413
414
415
416
417
418
419
420








+

#
# This proc returns stream trailer
#
proc wrapper:streamtrailer {} {
    return "</stream:stream>"
}

# vim:ts=8:sw=4:sts=4:noet
Added plugins/roster/TODO. 















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

* Reimplement restore logic so that roster contacts are always
  sent first.

* Probably rething the logic once more: in theory, it could be
  possible to populate roster with restored contacts w/o
  sending them to the server (which could be done independently,
  at any time). In this case we don't have to synchronize
  with restoring annotations.

* Gateways and "gated" contacts doesn't appear to have correct
  category/subtype -- investigate whether it's possible to
  use that heuristic mechs to get them on the fly as they're
  pushed from the server during the restoration process.







Changes to plugins/roster/annotations.tcl.






︙


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

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








-
+

-
-
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+








hook::add connected_hook [namespace current]::annotations::request_notes

proc annotations::process_notes {connid res child} {
    variable notes

    if {$res != "OK"} return

    array set notes {}
    free_notes $connid

    foreach ch $child {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 cdata1 children1
    foreach xmldata $child {
	jlib::wrapper:splitxml $xmldata tag vars isempty cdata children

	if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(rosternotes)} {
	    foreach note $children1 {
		jlib::wrapper:splitxml $note ntag nvars nisempty ncdata nchildren
	if {[jlib::wrapper:getattr $vars xmlns] == $::NS(rosternotes)} {
	    foreach note $children {
		create_note $connid $note
	    }
	}
    }
}

proc annotations::create_note {connid xmldata args} {
    variable notes

    set merge 0
    foreach {opt val} $args {
	switch -- $opt {
	    -merge { set merge $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be -merge"
	    }
	}
    }

    jlib::wrapper:splitxml $xmldata tag vars isempty cdata children

		set jid [jlib::wrapper:getattr $nvars jid]
		set cdate [jlib::wrapper:getattr $nvars cdate]
		set mdate [jlib::wrapper:getattr $nvars mdate]
		set notes($connid,jid,$jid) $jid
		if {![catch { scan_time $cdate } cdate]} {
		    set notes($connid,cdate,$jid) $cdate
		}
		if {![catch { scan_time $mdate } mdate]} {
		    set notes($connid,mdate,$jid) $mdate
		}
		set notes($connid,note,$jid) $ncdata
	    
	    }
    set jid [jlib::wrapper:getattr $vars jid]
    set cdate [jlib::wrapper:getattr $vars cdate]
    set mdate [jlib::wrapper:getattr $vars mdate]

    if {![catch { scan_time $cdate } cdate]} {
	set cdate [clock seconds]
    }
    if {![catch { scan_time $mdate } mdate]} {
	set cdate [clock seconds]
    }

    if {!$merge || [more_recent $connid $jid $cdate $mdate]} {
	set notes($connid,jid,$jid)   $jid
	set notes($connid,cdate,$jid) $cdate
	set notes($connid,mdate,$jid) $mdate
	set notes($connid,note,$jid)  $cdata
	return 1
    } else {
	}
	return 0
    }
}

proc annotations::scan_time {timestamp} {
    if {[regexp {(.*)T(.*)Z} $timestamp -> date time]} {
	return [clock scan "$date $time" -gmt true]
    } else {
	return [clock scan $timestamp -gmt true]
    }
}

proc annotations::more_recent {connid jid cdate mdate} {
    variable notes

    if {![info exists notes($connid,jid,$jid)]} {
	return 1
    } elseif {[info exists notes($connid,mdate,$jid)]} {
	return [expr {$mdate > $notes($connid,mdate,$jid)}]
    } elseif {[info exists notes($connid,cdate,$jid)]} {
	return [expr {$cdate > $notes($connid,cdate,$jid)}]
    } else {
	return 1
    }
}

proc annotations::cleanup_and_store_notes {connid} {
    variable notes

    set roster_jids {}
    foreach rjid [roster::get_jids $connid] {
	lappend roster_jids [node_and_server_from_jid $rjid]




︙


88
89
90
91
92
93
94
95

96
97
98
99
100
101
102

127
128
129
130
131
132
133

134
135
136
137
138
139
140
141








-
+








	    catch { unset notes($connid,note,$jid) }
	}
    }

    store_notes $connid
}

proc annotations::store_notes {connid} {
proc annotations::serialize_notes {connid} {
    variable notes

    set notelist {}
    foreach idx [array names notes $connid,jid,*] {
	set jid $notes($idx)

	set vars [list jid $jid]




︙


115
116
117
118
119
120
121
122
123
124







125
126
127
128
129
130
131

154
155
156
157
158
159
160



161
162
163
164
165
166
167
168
169
170
171
172
173
174








-
-
-
+
+
+
+
+
+
+








	    lappend notelist \
		[jlib::wrapper:createtag note \
		     -vars $vars \
		     -chdata $notes($connid,note,$jid)]
	}
    }

    private::store [list [jlib::wrapper:createtag storage \
			      -vars [list xmlns $::NS(rosternotes)] \
			      -subtags $notelist]] \
    jlib::wrapper:createtag storage \
	-vars [list xmlns $::NS(rosternotes)] \
	-subtags $notelist
}

proc annotations::store_notes {connid} {
    private::store [list [serialize_notes $connid]] \
	-command [list [namespace current]::store_notes_result $connid] \
	-connection $connid
}

proc annotations::store_notes_result {connid res child} {

    if {$res == "OK"} return




︙


299
300
301
302
303
304
305


342
343
344
345
346
347
348
349








+

    $n.text configure -state disabled
    pack $sw -side top -fill both -expand yes
    pack $n -fill both -expand yes
}

hook::add userinfo_hook [namespace current]::annotations::note_page 40

# vim:ts=8:sw=4:sts=4:noet






Added plugins/roster/backup.tcl.





























































































































































































































































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
235
236
237
238
239
240
241
242
243
244
245
246
247

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# $Id$
# Export/import of the roster items using an XML file.
# This code provides basic framework for handling roster backup
# files and it's able to serialize/deserialize regular roster contacts.
# Hooks provided to facilitate implementations of storing/restoring
# other kinds of data logically pertaining to the roster
# such as conference bookmarks, annotations, etc.

namespace eval rosterbackup {
    global NS
    set NS(rosterbackup) http://tkabber.jabber.ru/contactlist

    hook::add connected_hook \
	[namespace current]::setup_import_export_menus
    hook::add disconnected_hook \
	[namespace current]::setup_import_export_menus
    hook::add finload_hook \
	[namespace current]::setup_import_export_menus

    hook::add serialize_roster_hook \
	[namespace current]::serialize_roster_contacts
    hook::add deserialize_roster_hook \
	[namespace current]::deserialize_roster_contacts

    hook::add roster_push_hook \
	[namespace current]::process_roster_push
}

###############################################################################

proc rosterbackup::setup_import_export_menus {args} {
    set emenu [.mainframe getmenu export_roster]
    set imenu [.mainframe getmenu import_roster]

    if {[winfo exists $emenu]} {
	destroy $emenu
    }
    menu $emenu -tearoff 0

    if {[winfo exists $imenu]} {
	destroy $imenu
    }
    menu $imenu -tearoff 0

    if {[jlib::connections] == {}} {
	.mainframe setmenustate export_roster disabled
	.mainframe setmenustate import_roster disabled
    } else {
	.mainframe setmenustate export_roster normal
	.mainframe setmenustate import_roster normal
    }

    foreach c [jlib::connections] {
	set jid [jlib::connection_jid $c]
	set label [format [::msgcat::mc "Roster of %s"] $jid]
	set ecommand [list [namespace current]::export_to_file $c]
	set icommand [list [namespace current]::import_from_file $c]
	$emenu add command -label $label -command $ecommand
	$imenu add command -label $label -command $icommand
    }
}

###############################################################################

proc rosterbackup::export_to_file {connid} {
    set filename [tk_getSaveFile \
		      -initialdir $::configdir \
		      -initialfile [jlib::connection_user $connid]-roster.xml \
		      -filetypes [list \
				      [list [::msgcat::mc "Roster Files"] \
					   .xml] \
				      [list [::msgcat::mc "All Files"] *]]]
    if {$filename == ""} return

    set fd [open $filename w]
    fconfigure $fd -encoding utf-8

    puts $fd {<?xml version="1.0" encoding="UTF-8"?>}
    puts $fd [serialize_roster $connid]

    close $fd
}

###############################################################################

proc rosterbackup::serialize_roster {connid} {
    global NS

    set subtags [list]
    hook::run serialize_roster_hook $connid #[info level] subtags

    jlib::wrapper:createxml [jlib::wrapper:createtag contactlist \
	    -vars [list xmlns $NS(rosterbackup)] -subtags $subtags] \
	-prettyprint 1
}

###############################################################################

proc rosterbackup::serialize_roster_contacts {connid level varName} {
    upvar $level $varName subtags

    set items [list]
    foreach jid [::roster::get_jids $connid] {
	set category [::roster::itemconfig $connid $jid -category]
	switch -- $category {
	    user -
	    gateway {
		lappend items [::roster::item_to_xml $connid $jid]
	    }
	}
    }

    lappend subtags [jlib::wrapper:createtag roster \
	-vars {xmlns jabber:iq:roster} \
	-subtags $items]
}

###############################################################################

proc rosterbackup::import_from_file {connid} {
    set filename [tk_getOpenFile \
		      -initialdir $::configdir \
		      -initialfile [jlib::connection_user $connid]-roster.xml \
		      -filetypes [list \
				      [list [::msgcat::mc "Roster Files"] \
					   .xml] \
				      [list [::msgcat::mc "All Files"] *]]]
    if {$filename == ""} return

    set fd [open $filename r]
    fconfigure $fd -encoding utf-8
    set xml [string trimleft [read $fd] [format %c 0xFEFF]] ;# strip BOM, if any
    close $fd

    deserialize_roster $connid $xml
}

###############################################################################

proc rosterbackup::deserialize_roster {connid data} {
    hook::run roster_deserializing_hook $connid

    set parser [jlib::wrapper:new "#" "#" \
	[list [namespace current]::parse_roster_xml $connid]]
    jlib::wrapper:elementstart $parser stream:stream {} {}
    jlib::wrapper:parser $parser parse $data
    jlib::wrapper:parser $parser configure -final 0
    jlib::wrapper:free $parser

    hook::run roster_deserialized_hook $connid
}

###############################################################################

proc rosterbackup::parse_roster_xml {connid data} {
    global NS

    jlib::wrapper:splitxml $data tag vars isempty cdata children

    if {![string equal $tag contactlist]} {
	return -code error "Bad root element \"$tag\":\
	    must be contactlist"
    }
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(rosterbackup)]} {
	return -code error "Bad root element namespace \"$xmlns\":\
	    must be \"$NS(rosterbackup)\""
    }

    foreach child $children {
	hook::run deserialize_roster_hook $connid $child
    }
}

###############################################################################

proc rosterbackup::deserialize_roster_contacts {connid data} {
    global NS
    variable sent

    jlib::wrapper:splitxml $data tag vars isempty cdata children

    if {![string equal $tag roster]} return
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(roster)]} {
	return -code error "Bad roster element namespace \"$xmlns\":\
	    must be \"$NS(roster)\""
    }

    array set existing {}
    foreach jid [::roster::get_jids $connid] {
	set existing($jid) {}
    }

    upvar 0 sent($connid,jids) jids
    set jids [list]
    set subtags [list]

    foreach child $children {
	set jid [get_item_jid $child]
	if {![info exists existing($jid)]} {
	    lappend jids $jid
	    lappend subtags $child
	}
    }

    if {[llength $subtags] > 0} {
	set status [namespace current]::sent($connid,status)
	set $status WAITING
	jlib::send_iq set \
	    [jlib::wrapper:createtag query \
		 -vars [list xmlns $NS(roster)] \
		 -subtags $subtags] \
	    -connection $connid
	vwait $status
	unset $status
    }
}

###############################################################################

proc rosterbackup::get_item_jid {data} {
    jlib::wrapper:splitxml $data ? vars ? ? ?
    jlib::wrapper:getattr $vars jid
}

###############################################################################

proc rosterbackup::process_roster_push {connid jid name groups subsc ask} {
    variable sent
    upvar 0 sent($connid,status) status
    upvar 0 sent($connid,jids) jids

    if {[info exists status]} {
	set ix [lsearch -exact $jids $jid]
	if {$ix >= 0} {
	    if {[llength $jids] == 1} {
		unset jids
		set status COMPLETE
	    } else {
		set jids [lreplace $jids $ix $ix]
	    }
	}
    }
}

# vim:ts=8:sw=4:sts=4:noet






Added plugins/roster/bkup_annotations.tcl.


































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# $Id$
# Support for backup/restore of "annotations" (XEP-0145)
# for roster items.
# Depends on: annotations.tcl, backup.tcl

namespace eval annobackup {
    # Should probably go after the roster contacts, so we set prio to 60:
    hook::add serialize_roster_hook \
	[namespace current]::serialize_annotations 60
    hook::add deserialize_roster_hook \
	[namespace current]::deserialize_annotations 60
}

###############################################################################

proc annobackup::serialize_annotations {connid level varName} {
    upvar $level $varName subtags
    global NS

    set xmldata [::plugins::annotations::serialize_notes $connid]

    lappend subtags [jlib::wrapper:createtag privstorage \
	-vars {xmlns jabber:iq:private} \
	-subtags [list $xmldata]]
}

###############################################################################

proc annobackup::deserialize_annotations {connid data} {
    global NS

    jlib::wrapper:splitxml $data tag vars isempty cdata children
    if {![string equal $tag privstorage]} return
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(private)]} {
	return -code error "Bad roster element namespace \"$xmlns\":\
	    must be \"$NS(private)\""
    }

    set updated 0

    foreach storage $children {
	jlib::wrapper:splitxml $storage ctag cvars cisempty ccdata cchildren
	if {![string equal $ctag storage]} return
	set xmlns [jlib::wrapper:getattr $cvars xmlns]
	if {![string equal $xmlns $NS(rosternotes)]} return
	
	foreach child $cchildren {
	    set added [::plugins::annotations::create_note \
		    $connid $child -merge yes]
	    set updated [expr {$updated || $added}]
	}
    }

    if {$updated} {
	::plugins::annotations::cleanup_and_store_notes $connid
    }
}

# vim:ts=8:sw=4:sts=4:noet






Added plugins/roster/bkup_conferences.tcl.































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# $Id$
# Support for backup/restore of "roster bookmarks" to MUC rooms (XEP-0048, v1.0)
# Depends on: conferences.tcl, backup.tcl

namespace eval mucbackup {
    variable updated

    # Should probably go after the roster contacts, so we set prio to 70:
    hook::add serialize_roster_hook \
	[namespace current]::serialize_muc_bookmarks 70
    hook::add deserialize_roster_hook \
	[namespace current]::deserialize_muc_bookmarks 70
    hook::add roster_deserializing_hook \
	[namespace current]::prepare_deserialization
    hook::add roster_deserialized_hook \
	[namespace current]::push_bookmarks_to_roster
}

###############################################################################

proc mucbackup::serialize_muc_bookmarks {connid level varName} {
    upvar $level $varName subtags
    global NS

    foreach xmldata [::plugins::conferences::serialize_bookmarks $connid] {
	lappend subtags [jlib::wrapper:createtag privstorage \
	    -vars [list xmlns $NS(private)] \
	    -subtags [list $xmldata]]
    }
}

###############################################################################

proc mucbackup::prepare_deserialization {connid} {
    variable updated
    set updated($connid) 0
}

###############################################################################

proc mucbackup::deserialize_muc_bookmarks {connid data} {
    variable updated
    upvar 0 updated($connid) upd
    global NS

    jlib::wrapper:splitxml $data tag vars isempty cdata children
    if {![string equal $tag privstorage]} return
    set xmlns [jlib::wrapper:getattr $vars xmlns]
    if {![string equal $xmlns $NS(private)]} {
	return -code error "Bad roster element namespace \"$xmlns\":\
	    must be \"$NS(private)\""
    }

    foreach storage $children {
	jlib::wrapper:splitxml $storage ctag cvars cisempty ccdata cchildren
	if {![string equal $ctag storage]} return
	set xmlns [jlib::wrapper:getattr $cvars xmlns]
	switch -- $xmlns \
	    $NS(bookmarks) {
		foreach child $cchildren {
		    set added [::plugins::conferences::create_muc_bookmark \
			    $connid $child -merge yes]
		    set upd [expr {$upd || $added}]
		}
	    } \
	    $NS(tkabber:groups) {
		foreach child $cchildren {
		    set added [::plugins::conferences::create_muc_bmgroup \
			    $connid $child -merge yes]
		    set upd [expr {$upd || $added}]
		}
	    }
    }
}

###############################################################################

proc mucbackup::push_bookmarks_to_roster {connid} {
    variable updated

    if {$updated($connid)} {
	::plugins::conferences::push_bookmarks_to_roster $connid
	::plugins::conferences::store_bookmarks $connid
    }

    unset updated($connid)
}

# vim:ts=8:sw=4:sts=4:noet






Changes to plugins/roster/conferences.tcl.






︙


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

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








+








-
-
+
+
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-







-
+








}

hook::add connected_hook [namespace current]::conferences::request_bookmarks 20

proc conferences::process_bookmarks {connid res child} {
    variable bookmarks
    variable responds
    global NS

    if {$res != "OK"} return

    incr responds($connid)

    foreach ch $child {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 cdata1 children1

	if {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(bookmarks)} {
	    foreach bookmark $children1 {
	switch -- [jlib::wrapper:getattr $vars1 xmlns] \
	    $NS(bookmarks) {
		foreach bookmark $children1 {
		jlib::wrapper:splitxml $bookmark btag bvars bisempty bcdata bchildren

		    create_muc_bookmark $connid $bookmark
		if {$btag != "conference"} continue

		}
		set jid [string tolower [jlib::wrapper:getattr $bvars jid]]
		set bookmarks($connid,jid,$jid) $jid

		set bookmarks($connid,name,$jid) [jlib::wrapper:getattr $bvars name]
		set bookmarks($connid,nick,$jid) ""
		set bookmarks($connid,password,$jid) ""
		if {![info exists bookmarks($connid,groups,$jid)]} {
		    set bookmarks($connid,groups,$jid) {}
		}
	    } \

		set autojoin [jlib::wrapper:getattr $bvars autojoin]
		switch -- $autojoin {
		    1 -
		    true { set bookmarks($connid,autojoin,$jid) 1 }
		    default { set bookmarks($connid,autojoin,$jid) 0 }
		}
		
		foreach bch $bchildren {
		    jlib::wrapper:splitxml \
			$bch tag2 vars2 isempty2 cdata2 children2
		    switch -- $tag2 {
			nick { set bookmarks($connid,nick,$jid) $cdata2 }
			password { set bookmarks($connid,password,$jid) $cdata2 }
		    }
		}
	    }
	} elseif {[jlib::wrapper:getattr $vars1 xmlns] == $::NS(tkabber:groups)} {
	    foreach bookmark $children1 {
	    $NS(tkabber:groups) {
		foreach bookmark $children1 {
		jlib::wrapper:splitxml $bookmark btag bvars bisempty bcdata bchildren

		    create_muc_bmgroup $connid $bookmark
		if {$btag != "conference"} continue

		}
		set jid [string tolower [jlib::wrapper:getattr $bvars jid]]

	    }
		set groups {}
		foreach bch $bchildren {
		    jlib::wrapper:splitxml \
			$bch tag2 vars2 isempty2 cdata2 children2
		    switch -- $tag2 {
			group { lappend groups $cdata2 }
		    }
		}
		set bookmarks($connid,groups,$jid) $groups
	    }
	}
    }

    if {$responds($connid) < 2} return

    push_bookmarks_to_roster $connid
    after idle [list [namespace current]::autojoin_groups $connid]
}

proc conferences::create_muc_bookmark {connid xmldata args} {
    variable bookmarks

    set merge 0
    foreach {opt val} $args {
	switch -- $opt {
	    -merge { set merge $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be -merge"
	    }
	}
    }

    jlib::wrapper:splitxml $xmldata btag bvars bisempty bcdata bchildren

    if {![string equal $btag conference]} { return 0 }

    set jid [string tolower [jlib::wrapper:getattr $bvars jid]]

    if {$merge && [info exists bookmarks($connid,jid,$jid)]} {
	return 0
    } else {
	set bookmarks($connid,jid,$jid) $jid

	set bookmarks($connid,name,$jid) [jlib::wrapper:getattr $bvars name]
	set bookmarks($connid,nick,$jid) ""
	set bookmarks($connid,password,$jid) ""
	if {![info exists bookmarks($connid,groups,$jid)]} {
	    set bookmarks($connid,groups,$jid) {}
	    set bookmarks($connid,hasgroups,$jid) 0
	} else {
	    set bookmarks($connid,hasgroups,$jid) 1
	}

	set autojoin [jlib::wrapper:getattr $bvars autojoin]
	switch -- $autojoin {
	    1 -
	    true { set bookmarks($connid,autojoin,$jid) 1 }
	    default { set bookmarks($connid,autojoin,$jid) 0 }
	}
	
	foreach bch $bchildren {
	    jlib::wrapper:splitxml \
		$bch tag2 vars2 isempty2 cdata2 children2
	    switch -- $tag2 {
		nick { set bookmarks($connid,nick,$jid) $cdata2 }
		password { set bookmarks($connid,password,$jid) $cdata2 }
	    }
	}
	return 1
    }
}

proc conferences::create_muc_bmgroup {connid xmldata args} {
    variable bookmarks

    set merge 0
    foreach {opt val} $args {
	switch -- $opt {
	    -merge { set merge $val }
	    default {
		return -code error "Bad option \"$opt\":\
		    must be -merge"
	    }
	}
    }

    jlib::wrapper:splitxml $xmldata btag bvars bisempty bcdata bchildren

    if {![string equal $btag conference]} return

    set jid [string tolower [jlib::wrapper:getattr $bvars jid]]

    set groups [list]
    foreach bch $bchildren {
	jlib::wrapper:splitxml $bch tag2 vars2 isempty2 cdata2 children2
	if {[string equal $tag2 group]} {
	    lappend groups $cdata2
	}
    }

    if {$merge && [info exists bookmarks($connid,jid,$jid)]
		&& $bookmarks($connid,hasgroups,$jid)} {
	return 0
    } else {
	set bookmarks($connid,groups,$jid) $groups
	set bookmarks($connid,hasgroups,$jid) 1
	return 1
    }
}

proc conferences::push_bookmarks_to_roster {connid} {
    variable bookmarks

    foreach idx [array names bookmarks $connid,jid,*] {
	set jid $bookmarks($idx)
	client:roster_push $connid $jid $bookmarks($connid,name,$jid) \
			   $bookmarks($connid,groups,$jid) \
			   bookmark ""
	roster::override_category_and_subtype $connid $jid conference ""
    }
    after idle [list [namespace current]::autojoin_groups $connid]
}

###############################################################################
#
#   Store bookmarks
#

proc conferences::store_bookmarks {connid} {
proc conferences::serialize_bookmarks {connid} {
    variable bookmarks

    set bookmarklist {}
    set grouplist {}
    foreach idx [array names bookmarks $connid,jid,*] {
	set jid $bookmarks($idx)
	set name $bookmarks($connid,name,$jid)




︙


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

244
245
246
247
248
249
250



251
252
253








254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271








-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+








				-chdata $group]
	}
	lappend grouplist [jlib::wrapper:createtag conference \
			       -vars $vars \
			       -subtags $groups]
    }

    private::store [list [jlib::wrapper:createtag storage \
			      -vars [list xmlns $::NS(bookmarks)] \
			      -subtags $bookmarklist]] \
    list [jlib::wrapper:createtag storage \
	    -vars [list xmlns $::NS(bookmarks)] \
	    -subtags $bookmarklist] \
	-command [list [namespace current]::store_bookmarks_result $connid] \
	-connection $connid

    private::store [list [jlib::wrapper:createtag storage \
			      -vars [list xmlns $::NS(tkabber:groups)] \
			      -subtags $grouplist]] \
	-command [list [namespace current]::store_bookmarks_result $connid] \
	-connection $connid
	[jlib::wrapper:createtag storage \
	    -vars [list xmlns $::NS(tkabber:groups)] \
	    -subtags $grouplist]
}

proc conferences::store_bookmarks {connid} {
    foreach item [serialize_bookmarks $connid] {
	private::store [list $item] \
	    -command [list [namespace current]::store_bookmarks_result $connid] \
	    -connection $connid
    }
}

proc conferences::store_bookmarks_result {connid res child} {

    if {$res == "OK"} return

    if {[winfo exists .store_bookmarks_error]} {




︙


434
435
436
437
438
439
440

441
442
443
444
445
446
447

496
497
498
499
500
501
502
503
504
505
506
507
508
509
510








+









    set bookmarks($connid,jid,$jid) $jid
    set bookmarks($connid,name,$jid) $name
    set bookmarks($connid,nick,$jid) $nick
    set bookmarks($connid,password,$jid) $password
    set bookmarks($connid,autojoin,$jid) $autojoin
    set bookmarks($connid,groups,$jid) $groups
    set bookmarks($connid,hasgroups,$jid) 1

    # TODO should we remove $jid from the roster if it is here?
    client:roster_push $connid $jid $name $groups bookmark ""
    roster::override_category_and_subtype $connid $jid conference ""
    store_bookmarks $connid
}





︙


530
531
532
533
534
535
536

537
538
539
540
541
542
543

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607








+









    catch { unset bookmarks($connid,jid,$jid) }
    catch { unset bookmarks($connid,name,$jid) }
    catch { unset bookmarks($connid,nick,$jid) }
    catch { unset bookmarks($connid,password,$jid) }
    catch { unset bookmarks($connid,autojoin,$jid) }
    catch { unset bookmarks($connid,groups,$jid) }
    catch { unset bookmarks($connid,hasgroups,$jid) }

    store_bookmarks $connid

    return stop
}

hook::add roster_remove_item_hook \




︙


861
862
863
864
865
866
867
868
869


925
926
927
928
929
930
931


932








-
-
+

	}
    }
}

hook::add disco_node_menu_hook \
	  [namespace current]::conferences::disco_node_menu_setup 50

###############################################################################

# vim:ts=8:sw=4:sts=4:noet






Changes to roster.tcl.






︙


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

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
235
236
237
238








-
-
+
+
+
+
+
+



-
+
+
+
+
+













-
-
+
+
+
+
+
+
+
+








    if {[llength $args] == 1} {
	lassign $args attr
	switch -- $attr {
	    -group    {set param group}
	    -name     {set param name}
	    -subsc    {set param subsc}
	    -ask      {set param ask}
	    -category {set param category}
	    -subtype  {set param subtype}
	    -category {
		return [lindex [get_category_and_subtype $connid $jid] 0]
	    }
	    -subtype  {
		return [lindex [get_category_and_subtype $connid $jid] 1]
	    }
	    -isuser   {
		return [cequal [lindex [get_category_and_subtype $connid $jid] 0] "user"]
	    }
	    default   {return -code error "Illegal option"}
	    default   {
		return -code error "Bad option \"$attr\":\
		    must be one of: -group, -name, -subsc, -ask,\
		    -category, -subtype or -isuser"
	    }
	}
	if {[info exists roster($param,$connid,$jid)]} {
	    return $roster($param,$connid,$jid)
	} else {
	    return ""
	}
    } else {
	foreach {attr val} $args {
	    switch -- $attr {
		-group    {set param group}
		-name     {set param name}
		-subsc    {set param subsc}
		-ask      {set param ask}
		-category {set param category}
		-subtype  {set param subtype}
		-category {
		    override_category $connid $jid $val
		    continue
		}
		-subtype  {
		    override_subtype $connid $jid $val
		    continue
		}
		default   {return -code error "Illegal option"}
	    }
	    set roster($param,$connid,$jid) $val
	}
    }
}





︙


287
288
289
290
291
292
293

















294
295
296
297
298
299
300

301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









proc roster::override_category_and_subtype {connid jid category subtype} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list $category $subtype]
}

proc roster::override_category {connid jid category} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list $category \
	    [lindex $roster(overridden_category_and_subtype,$connid,$jid) 1]]
}

proc roster::override_subtype {connid jid subtype} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list \
	    [lindex $roster(overridden_category_and_subtype,$connid,$jid) 0] \
	    $subtype]
}

proc roster::get_category_and_subtype {connid jid} {
    variable roster

    if {[info exists roster(overridden_category_and_subtype,$connid,$jid)]} {
	return $roster(overridden_category_and_subtype,$connid,$jid)
    }




︙


397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426

428
429
430
431
432
433
434

435
436
437
438
439
440
441
442
443
444
445
446
447
448

449
450
451
452
453
454
455








-














-








    variable roster

    array unset roster jids,*
    array unset roster group,*
    array unset roster name,*
    array unset roster subsc,*
    array unset roster ask,*
    array unset roster category,*
    array unset roster subtype,*
    array unset roster cached_category_and_subtype,*
    array unset roster overridden_category_and_subtype,*
    ::redraw_roster
}

proc roster::clean_connection {connid} {
    variable roster

    array unset roster jids,$connid
    array unset roster group,$connid,*
    array unset roster name,$connid,*
    array unset roster subsc,$connid,*
    array unset roster ask,$connid,*
    array unset roster category,$connid,*
    array unset roster subtype,$connid,*
    array unset roster cached_category_and_subtype,$connid,*
    array unset roster overridden_category_and_subtype,$connid,*

    ::redraw_roster
}





︙










This page was generated in about
0.034s by
Fossil version [1205ec86cb] 2025-04-30 16:57:32