1# $Id$
2#
3# Privacy lists support (XEP-0016)
4#
5
6package require xmpp::privacy
7
8namespace eval privacy {
9    variable options
10
11    array set req_messages \
12	[list ignore     [::msgcat::mc "Requesting ignore list: %s"] \
13	      invisible  [::msgcat::mc "Requesting invisible list: %s"] \
14	      visible    [::msgcat::mc "Requesting visible list: %s"] \
15	      conference [::msgcat::mc "Requesting conference list: %s"]]
16
17    array set send_messages \
18	[list ignore       [::msgcat::mc "Sending ignore list: %s"] \
19	      invisible    [::msgcat::mc "Sending invisible list: %s"] \
20	      visible      [::msgcat::mc "Sending visible list: %s"] \
21	      conference   [::msgcat::mc "Sending conference list: %s"] \
22	      subscription [::msgcat::mc "Changing accept messages from roster only: %s"]]
23
24    array set edit_messages \
25	[list ignore     [::msgcat::mc "Edit ignore list"] \
26	      invisible  [::msgcat::mc "Edit invisible list"] \
27	      visible    [::msgcat::mc "Edit visible list"] \
28	      conference [::msgcat::mc "Edit conference list"]]
29
30    array set menu_messages \
31	[list ignore     [::msgcat::mc "Ignore list"] \
32	      invisible  [::msgcat::mc "Invisible list"] \
33	      visible    [::msgcat::mc "Visible list"]]
34
35    variable accept_from_roster 0
36
37    custom::defgroup Privacy \
38	[::msgcat::mc "Blocking communication (XMPP privacy lists) options."] \
39	-group Tkabber
40
41    custom::defvar options(activate_at_startup) 1 \
42	[::msgcat::mc "Activate visible/invisible/ignore/conference lists\
43		       before sending initial presence."] \
44	-type boolean -group Privacy
45}
46
47###############################################################################
48#
49# Manual rules editing block
50#
51
52proc privacy::request_lists {xlib} {
53
54    if {$xlib == ""} {
55	set xlib [first_supported]
56    }
57    if {$xlib == ""} return
58
59    ::xmpp::privacy::requestLists $xlib \
60	    -command [namespace code [list open_dialog $xlib]]
61}
62
63
64proc privacy::on_destroy_dialog {} {
65    variable data
66
67    catch { array unset data }
68}
69
70
71proc privacy::open_dialog {xlib res child} {
72    if {[string equal $res error]} {
73	MessageDlg .privacy_err -aspect 50000 -icon error \
74	    -message [::msgcat::mc "Requesting privacy rules: %s" \
75			  [error_to_string $child]] \
76	    -type user -buttons ok -default 0 -cancel 0
77	return
78    }
79
80    set w .privacy
81
82    if {[winfo exists $w]} {
83	destroy $w
84    }
85
86    Dialog $w -title [::msgcat::mc "Privacy lists"] \
87	-modal none -separator 1 -anchor e \
88	-default 0 -cancel 1
89
90    set f [$w getframe]
91
92    bind $f <Destroy> [namespace code on_destroy_dialog]
93
94    $w add -text [::msgcat::mc "Send"] \
95	   -command [namespace code [list send_lists $xlib $w]]
96    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
97
98    set f [$w getframe]
99
100    set hf [frame $w.hf]
101    pack $hf -side bottom
102
103    set tools [frame $f.tools]
104    pack $tools -side bottom -fill x -padx 1m
105
106    set sw [ScrolledWindow $w.sw -scrollbar vertical]
107    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
108    pack $sw -side bottom -expand yes -fill both -in $f -pady 1m -padx 1m
109    set lf [$sf getframe]
110    $sw setwidget $sf
111
112    set addlist [button $tools.addlist \
113		     -text [::msgcat::mc "Add list"] \
114		     -command [namespace code [list add_list \
115				   $xlib $tools $lf ""]]]
116    pack $addlist -side right -padx 1m
117
118    set default [radiobutton $tools.default \
119		     -text [::msgcat::mc "No default list"] \
120		     -variable [namespace current]::data(default) \
121		     -value "\u0000"]
122    pack $default -side left -padx 1m
123
124    set active [radiobutton $tools.active \
125		    -text [::msgcat::mc "No active list"] \
126		    -variable [namespace current]::data(active) \
127		    -value "\u0000"]
128    pack $active -side left -padx 1m
129
130    fill_lists $xlib $hf $lf $child
131
132    $w draw
133}
134
135
136proc privacy::fill_lists {xlib hf f items} {
137    variable data
138
139    grid [label $f.n -text [::msgcat::mc "List name"] -width 20] \
140	-row 0 -column 0 -sticky we -padx 1m
141    grid [label $f.d -text [::msgcat::mc "Default"]] \
142	-row 0 -column 1 -sticky we -padx 1m
143    grid [label $f.a -text [::msgcat::mc "Active"]] \
144	-row 0 -column 2 -sticky we -padx 1m
145
146    grid columnconfigure $f 0 -weight 1
147    grid columnconfigure $f 1 -weight 1
148    grid columnconfigure $f 2 -weight 1
149    grid columnconfigure $f 3 -weight 1
150    grid columnconfigure $f 4 -weight 1
151
152    array set tmp $items
153
154    if {[info exists tmp(default)]} {
155	set data(default) $tmp(default)
156    } else {
157	set data(default) "\u0000"
158    }
159    if {[info exists tmp(active)]} {
160	set data(active) $tmp(active)
161    } else {
162	set data(active) "\u0000"
163    }
164    set data(nlists) 0
165
166    foreach name $tmp(items) {
167	add_list $xlib $hf $f $name
168    }
169}
170
171
172proc privacy::remove_list {lf ln} {
173    variable data
174
175    destroy $lf.name$ln
176    destroy $lf.active$ln
177    destroy $lf.default$ln
178    destroy $lf.edit$ln
179    destroy $lf.remove$ln
180    set data(nitems,$ln) 0
181    set data(newname,$ln) ""
182}
183
184
185proc privacy::::on_change_list_name {lf i args} {
186    variable data
187
188    set name $data(newname,$i)
189
190    if {$data(default) == $data(name,$i)} {
191	set data(default) $name
192    }
193    if {$data(active) == $data(name,$i)} {
194	set data(active) $name
195    }
196
197    if {[winfo exists $lf.default$i] && [winfo exists $lf.active$i]} {
198	$lf.default$i configure -value $name
199	$lf.active$i configure -value $name
200    }
201    if {$name != ""} {
202	set data(name,$i) $name
203    }
204}
205
206
207proc privacy::add_list {xlib hf lf name} {
208    variable data
209
210    set i $data(nlists)
211
212    if {$name == ""} {
213	set name "list$i"
214	send_new_list $xlib $name
215    }
216
217    set data(name,$i) $name
218    set data(newname,$i) $name
219
220    trace variable [namespace current]::data(newname,$i) w \
221	[list [namespace current]::on_change_list_name $lf $i]
222
223    set lname [label $lf.name$i \
224		   -text $name \
225		   -textvariable [namespace current]::data(name,$i)]
226    set default [radiobutton $lf.default$i \
227		     -variable [namespace current]::data(default) \
228		     -value $name]
229    set active [radiobutton $lf.active$i \
230		    -variable [namespace current]::data(active) \
231		    -value $name]
232    set remove [button $lf.remove$i \
233		    -text [::msgcat::mc "Remove list"] \
234		    -command [list [namespace current]::remove_list $lf $i]]
235    set edit [button $lf.edit$i \
236		  -text [::msgcat::mc "Edit list"] \
237		  -command [list [namespace current]::edit_list $xlib $lf $i]]
238
239    set row [expr {$i + 1}]
240    grid $lname   -row $row -column 0 -stick w  -padx 1m
241    grid $default -row $row -column 1 -stick we -padx 1m
242    grid $active  -row $row -column 2 -stick we -padx 1m
243    grid $edit    -row $row -column 3 -stick we -padx 1m
244    grid $remove  -row $row -column 4 -stick we -padx 1m
245
246    update idletasks
247    $hf configure \
248	-width [expr {[winfo reqwidth $lf] + [winfo pixels $lf 1c]}]
249
250    incr data(nlists)
251}
252
253
254proc privacy::edit_list {xlib lf ln} {
255    variable data
256
257    set name $data(name,$ln)
258
259    ::xmpp::privacy::requestItems $xlib $name \
260	    -command [namespace code [list edit_list_dialog $xlib $ln $name]]
261}
262
263
264proc privacy::edit_list_dialog {xlib ln name res child} {
265    if {[string equal $res error]} {
266	MessageDlg .privacy_list_err -aspect 50000 -icon error \
267	    -message [::msgcat::mc "Requesting privacy list: %s" \
268			  [error_to_string $child]] \
269	    -type user -buttons ok -default 0 -cancel 0
270	set child {}
271    }
272
273    set w .privacy_list
274
275    if {[winfo exists $w]} {
276	destroy $w
277    }
278
279    Dialog $w -title [::msgcat::mc "Edit privacy list"] \
280	-separator 1 -anchor e \
281	-default 0 -cancel 1
282
283    $w add -text [::msgcat::mc "Send"] \
284	-command [namespace code [list send_list $xlib $ln $w]]
285    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
286
287    set f [$w getframe]
288
289    set tools [frame $f.tools]
290    pack $tools -side bottom -fill x
291
292    set hf [frame $w.hf]
293    pack $hf -side bottom
294
295    set sw [ScrolledWindow $w.sw -scrollbar vertical]
296    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
297    set lf [$sf getframe]
298    pack $sw -side top -expand yes -fill both -in $f -pady 1m
299    $sw setwidget $sf
300
301    set additem [button $tools.aditem \
302		     -text [::msgcat::mc "Add item"] \
303		     -command \
304		     [namespace code [list add_item \
305			  $lf.items "none" "" "allow" 1 1 1 1]]]
306    pack $additem -side right -padx 1m
307
308    fill_edit_list $lf $name $child
309
310    update idletasks
311    $hf configure \
312	-width [expr {[winfo reqwidth $lf] + [winfo pixels $lf 1c]}]
313
314    $w draw
315}
316
317
318proc privacy::fill_edit_list {fr name items} {
319    variable data
320
321    set data(listname) $name
322    set data(listnewname) $name
323
324    set fname [frame $fr.name]
325    pack $fname -side top -fill x
326    label $fname.lname -text [string trimright [::msgcat::mc "Name: "]]
327    entry $fname.name \
328	-textvariable [namespace current]::data(listnewname)
329    pack $fname.lname -side left -anchor w
330    pack $fname.name -side left -fill x -expand yes
331
332    set f [frame $fr.items]
333    pack $f -side top -fill both -expand yes
334
335    label $f.ltype        -text [::msgcat::mc "Type"]
336    label $f.lvalue       -text [::msgcat::mc "Value"]
337    label $f.laction      -text [::msgcat::mc "Action"]
338    label $f.lmessage     -text [::msgcat::mc "Message"]
339    label $f.lpresencein  -text [::msgcat::mc "Presence-in"]
340    label $f.lpresenceout -text [::msgcat::mc "Presence-out"]
341    label $f.liq          -text [::msgcat::mc "IQ"]
342    grid $f.ltype        -row 0 -column 0 -sticky we -padx 0.5m
343    grid $f.lvalue       -row 0 -column 1 -sticky we -padx 0.5m
344    grid $f.laction      -row 0 -column 2 -sticky we -padx 0.5m
345    grid $f.lmessage     -row 0 -column 3 -sticky we -padx 0.5m
346    grid $f.lpresencein  -row 0 -column 4 -sticky we -padx 0.5m
347    grid $f.lpresenceout -row 0 -column 5 -sticky we -padx 0.5m
348    grid $f.liq          -row 0 -column 6 -sticky we -padx 0.5m
349    grid columnconfig $f 1 -weight 1
350
351    set data(listnitems) 0
352    foreach item $items {
353	set type [::xmpp::xml::getAttr $item type]
354	if {$type == ""} {
355	    set type none
356	}
357	set value [::xmpp::xml::getAttr $item value]
358	set action [::xmpp::xml::getAttr $item action]
359
360	set stanzas [::xmpp::xml::getAttr $item stanzas]
361	if {[llength $stanzas] == 0} {
362	    array set tmp [list message 1 presence-in 1 presence-out 1 iq 1]
363	} else {
364	    array set tmp [list message 0 presence-in 0 presence-out 0 iq 0]
365	    foreach tag $stanzas {
366		set tmp($tag) 1
367	    }
368	}
369
370	add_item $f $type $value $action \
371		 $tmp(message) $tmp(presence-in) $tmp(presence-out) $tmp(iq)
372    }
373}
374
375
376proc privacy::add_item {f type value action message presencein presenceout iq} {
377    variable data
378
379    set i $data(listnitems)
380
381    entry $f.value$i \
382	-textvariable [namespace current]::data(value,$i)
383    ComboBox $f.type$i \
384	-values {none jid group subscription} \
385	-editable no \
386	-width 12 \
387	-textvariable [namespace current]::data(type,$i)
388    ComboBox $f.action$i \
389	-values {allow deny} \
390	-editable no \
391	-width 5 \
392	-textvariable [namespace current]::data(action,$i)
393    checkbutton $f.message$i \
394	-variable [namespace current]::data(message,$i) \
395	-command [list [namespace current]::update_checkbuttons $i]
396    checkbutton $f.presencein$i \
397	-variable [namespace current]::data(presencein,$i) \
398	-command [list [namespace current]::update_checkbuttons $i]
399    checkbutton $f.presenceout$i \
400	-variable [namespace current]::data(presenceout,$i) \
401	-command [list [namespace current]::update_checkbuttons $i]
402    checkbutton $f.iq$i \
403	-variable [namespace current]::data(iq,$i) \
404	-command [list [namespace current]::update_checkbuttons $i]
405    button $f.moveup$i -text [::msgcat::mc "Up"] \
406	-command [list [namespace current]::move_item_up $f $i]
407    button $f.movedown$i -text [::msgcat::mc "Down"] \
408	-command [list [namespace current]::move_item_down $f $i]
409    button $f.remove$i -text [::msgcat::mc "Remove"] \
410	-command [list [namespace current]::remove_item $f $i]
411
412    set data(type,$i)        $type
413    set data(value,$i)       $value
414    set data(action,$i)      $action
415    set data(message,$i)     $message
416    set data(presencein,$i)  $presencein
417    set data(presenceout,$i) $presenceout
418    set data(iq,$i)          $iq
419
420    set row [expr {$i + 1}]
421    grid $f.type$i        -row $row -column 0 -sticky ew -padx 0.5m
422    grid $f.value$i       -row $row -column 1 -sticky ew -padx 0.5m
423    grid $f.action$i      -row $row -column 2 -sticky ew -padx 0.5m
424    grid $f.message$i     -row $row -column 3 -sticky ew -padx 0.5m
425    grid $f.presencein$i  -row $row -column 4 -sticky ew -padx 0.5m
426    grid $f.presenceout$i -row $row -column 5 -sticky ew -padx 0.5m
427    grid $f.iq$i          -row $row -column 6 -sticky ew -padx 0.5m
428    grid $f.moveup$i      -row $row -column 7 -sticky ew -padx 0.5m
429    grid $f.movedown$i    -row $row -column 8 -sticky ew -padx 0.5m
430    grid $f.remove$i      -row $row -column 9 -sticky ew -padx 0.5m
431
432    incr data(listnitems)
433    update_button_states $f
434}
435
436
437proc privacy::update_checkbuttons {i} {
438    variable data
439
440    if {!$data(message,$i) && !$data(presencein,$i) && \
441	    !$data(presenceout,$i) && !$data(iq,$i)} {
442	set data(message,$i) 1
443	set data(presencein,$i) 1
444	set data(presenceout,$i) 1
445	set data(iq,$i) 1
446    }
447}
448
449
450proc privacy::update_button_states {f} {
451    variable data
452
453    set numrows 0
454    set row 0
455    for {set i 0} {$i < $data(listnitems)} {incr i} {
456	if {$data(type,$i) != "remove"} {
457	    $f.remove$i configure -state normal
458	    incr numrows
459	    set row $i
460	}
461    }
462    if {$numrows == 1} {
463	$f.remove$row configure -state disabled
464    }
465}
466
467
468proc privacy::move_item_up {f i} {
469    variable data
470
471    set j $i
472    incr j -1
473    while {$j >= 0 && $data(type,$j) == "remove"} {
474	incr j -1
475    }
476
477    if {$j >= 0} {
478	switch_items $f $i $j
479    }
480}
481
482
483proc privacy::move_item_down {f i} {
484    variable data
485
486    set j $i
487    incr j 1
488    while {$j < $data(listnitems) && $data(type,$j) == "remove"} {
489	incr j 1
490    }
491
492    if {$j < $data(listnitems)} {
493	switch_items $f $i $j
494    }
495}
496
497
498proc privacy::switch_items {f i j} {
499    variable data
500
501    set type        $data(type,$i)
502    set value       $data(value,$i)
503    set action      $data(action,$i)
504    set message     $data(message,$i)
505    set presencein  $data(presencein,$i)
506    set presenceout $data(presenceout,$i)
507    set iq          $data(iq,$i)
508
509    set data(type,$i)        $data(type,$j)
510    set data(value,$i)       $data(value,$j)
511    set data(action,$i)      $data(action,$j)
512    set data(message,$i)     $data(message,$j)
513    set data(presencein,$i)  $data(presencein,$j)
514    set data(presenceout,$i) $data(presenceout,$j)
515    set data(iq,$i)          $data(iq,$j)
516
517    set data(type,$j)        $type
518    set data(value,$j)       $value
519    set data(action,$j)      $action
520    set data(message,$j)     $message
521    set data(presencein,$j)  $presencein
522    set data(presenceout,$j) $presenceout
523    set data(iq,$j)          $iq
524}
525
526
527proc privacy::remove_item {f i} {
528    variable data
529
530    destroy $f.type$i
531    destroy $f.value$i
532    destroy $f.action$i
533    destroy $f.message$i
534    destroy $f.presencein$i
535    destroy $f.presenceout$i
536    destroy $f.iq$i
537    destroy $f.moveup$i
538    destroy $f.movedown$i
539    destroy $f.remove$i
540
541    set data(type,$i) remove
542    set data(value,$i) ""
543    set data(action,$i) allow
544
545    update_button_states $f
546}
547
548
549proc privacy::send_new_list {xlib name} {
550    ::xmpp::privacy::sendItems $xlib $name {{action allow}} -command #
551}
552
553
554proc privacy::send_list {xlib ln w} {
555    variable data
556
557    set name $data(listnewname)
558    ::xmpp::privacy::sendItems $xlib $name [list_items] -command #
559
560    if {$name != $data(listname)} {
561	if {$data(default) == $data(listname)} {
562	    send_default_or_active_list $xlib $name default -command #
563	}
564	::xmpp::privacy::sendItems $xlib $data(listname) {} -command #
565	set data(newname,$ln) $name
566    }
567
568    destroy $w
569}
570
571
572proc privacy::send_lists {xlib w} {
573    variable data
574
575    for {set i 0} {$i < $data(nlists)} {incr i} {
576        if {$data(newname,$i) == ""} {
577            ::xmpp::privacy::sendItems $xlib $data(name,$i) {} -command #
578        }
579    }
580
581    send_default_or_active_list $xlib $data(active) active -command #
582    send_default_or_active_list $xlib $data(default) default -command #
583
584    destroy $w
585}
586
587
588proc privacy::list_items {} {
589    variable data
590
591    set items {}
592    for {set i 0} {$i < $data(listnitems)} {incr i} {
593	if {$data(type,$i) == "remove"} continue
594
595	set vars [list action $data(action,$i)]
596	if {$data(type,$i) != "none"} {
597	    lappend vars type $data(type,$i) value $data(value,$i)
598	}
599
600	set stanzas {}
601	if {$data(message,$i)} {
602	    lappend stanzas message
603	}
604	if {$data(presencein,$i)} {
605	    lappend stanzas presence-in
606	}
607	if {$data(presenceout,$i)} {
608	    lappend stanzas presence-out
609	}
610	if {$data(iq,$i)} {
611	    lappend stanzas iq
612	}
613	if {[llength $stanzas] == 4} {
614	    set stanzas {}
615	}
616	lappend vars stanzas $stanzas
617
618	lappend items $vars
619    }
620    return $items
621}
622
623###############################################################################
624
625proc privacy::send_default_or_active_list {xlib name tag args} {
626    set newargs {}
627    foreach {opt val} $args {
628	switch -- $opt {
629	    -command { lappend newargs -command $val }
630	}
631    }
632
633    if {$name != "\u0000"} {
634	lappend newargs -name $name
635    }
636
637    switch -- $tag {
638	default {
639	    return [eval [list ::xmpp::privacy::setDefault $xlib] $newargs]
640	}
641	active {
642	    return [eval [list ::xmpp::privacy::setActive $xlib] $newargs]
643	}
644    }
645}
646
647###############################################################################
648#
649# Visible, invisible, ignore, conference list block
650#
651
652proc privacy::edit_special_list {xlib name args} {
653    if {$xlib == ""} {
654	set xlib [first_supported]
655    }
656    if {$xlib == ""} return
657
658    ::xmpp::privacy::requestItems $xlib $name-list \
659	-command [namespace code [list edit_special_list_dialog $xlib $name]]
660}
661
662
663proc privacy::edit_special_list_dialog {xlib name res child} {
664    variable req_messages
665    variable edit_messages
666
667    if {[string equal $res error]} {
668	if {[error_type_condition $child] != {cancel item-not-found}} {
669	    MessageDlg .privacy_list_err -aspect 50000 -icon error \
670		-message [format $req_messages($name) [error_to_string $child]] \
671		-type user -buttons ok -default 0 -cancel 0
672	    return
673	}
674	set child {}
675    }
676
677    set w .privacy_list
678
679    if {[winfo exists $w]} {
680	destroy $w
681    }
682
683    Dialog $w -title $edit_messages($name) \
684	-modal none -separator 1 -anchor e \
685	-default 0 -cancel 1
686
687    $w add -text [::msgcat::mc "Send"] \
688	-command [list [namespace current]::edit_special_list_enddialog \
689		       $xlib $w $name]
690    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
691
692    set f [$w getframe]
693
694    set tools [frame $f.tools]
695    pack $tools -side bottom -fill x
696
697    set sw [ScrolledWindow $w.sw]
698    set lf [listbox $w.fields]
699    pack $sw -side top -expand yes -fill both -in $f -pady 1m -padx 1m
700    $sw setwidget $lf
701
702    bind $lf <<ContextMenu>> [list [namespace current]::select_and_popup_menu %W %x %y]
703
704    set addentry [entry $tools.addentry]
705    set additem [button $tools.additem \
706		     -text [::msgcat::mc "Add JID"] \
707		     -command \
708		     [list [namespace current]::add_special_jid_entry $lf $addentry]]
709    pack $additem -side right -padx 1m
710    pack $addentry -side left -padx 1m -fill x -expand yes
711
712    fill_edit_special_list $lf $name $child
713
714    #update idletasks
715    #$tools configure -width [winfo reqwidth $lf]
716
717    DropSite::register $lf -dropcmd [list [namespace current]::dropcmd] \
718        -droptypes {JID}
719
720    $w draw
721}
722
723
724proc privacy::edit_special_list_enddialog {xlib w name} {
725    $w itemconfigure 0 -state disabled
726    send_special_list $xlib $name [$w.fields get 0 end]
727    destroy $w
728}
729
730
731proc privacy::send_special_list {xlib name items} {
732    variable special_list
733    variable cboxes
734
735    if {![is_supported $xlib]} {
736	return
737    }
738
739    if {![info exists special_list($xlib,$name)]} {
740	set special_list($xlib,$name) {}
741    }
742
743    set newitems {}
744    foreach jid $items {
745	if {[lsearch -exact $special_list($xlib,$name) $jid] < 0} {
746	    lappend newitems $jid
747	}
748    }
749
750    set olditems {}
751    foreach jid $special_list($xlib,$name) {
752	if {[lsearch -exact $items $jid] < 0} {
753	    lappend olditems $jid
754	}
755    }
756
757    switch -- $name {
758	ignore {
759	    set stanzas {}
760	    set action deny
761	    foreach jid $newitems {
762		send_custom_presence $xlib $jid unavailable
763	    }
764	    set postitems $olditems
765	}
766	invisible {
767	    set stanzas {presence-out iq}
768	    set action deny
769	    foreach jid $newitems {
770		send_custom_presence $xlib $jid unavailable
771	    }
772	    set postitems $olditems
773	}
774	visible {
775	    # TODO: invisibility
776	    set stanzas {}
777	    set action allow
778	    set postitems $newitems
779	}
780	conference {
781	    set stanzas {}
782	    set action allow
783	    set postitems {}
784	}
785    }
786
787    set items1 {}
788    foreach item $items {
789	lappend items1 [list type    jid \
790			     value   $item \
791			     action  $action \
792			     stanzas $stanzas]
793    }
794
795    # We have to use synchronous mode because all privacy lists should be updated
796    # before sending next stanzas
797    set status [catch {::xmpp::privacy::sendItems $xlib "$name-list" $items1} msg]
798
799    update_tkabber_lists $xlib $name $items $postitems $status $msg
800}
801
802# subscription-list is responsible for blocking all messages
803# not from the roster.
804proc privacy::send_subscription_list {xlib} {
805    variable accept_from_roster_only
806
807    if {![is_supported $xlib]} {
808	return
809    }
810
811    if {$accept_from_roster_only} {
812	set items [list [list type   subscription \
813			      value  none \
814			      action deny]]
815    } else {
816	set items {}
817    }
818
819    # If items aren't empty, we'll never send unavailable presence to
820    # all users to whom directed presence was sent. Bug?
821
822    # We have to use synchronous mode because all privacy lists should be updated
823    # before sending next stanzas
824    set status [catch {::xmpp::privacy::sendItems $xlib "subscription-list" $items} msg]
825
826    update_tkabber_lists $xlib subscription $items {} $status $msg
827}
828
829
830proc privacy::on_accept_from_roster_only_change {xlib} {
831    if {$xlib == ""} {
832	set xlib [first_supported]
833    }
834    if {$xlib == ""} return
835
836    send_subscription_list $xlib
837}
838
839
840proc privacy::update_tkabber_lists {xlib name items postitems status msg} {
841    global userstatus textstatus statusdesc
842    variable send_messages
843    variable special_list
844    variable cboxes
845
846    if {$status == 3} {
847	# break
848	return
849    }
850
851    switch -- $name {
852	subscription {
853	    # Subscription list doesn't contain JIDs
854	}
855	default {
856	    # Workaround for servers without privacy list support/push
857	    if {$status == 0} {
858		# ok
859		set special_list($xlib,$name) $items
860	    }
861	    array unset cboxes $xlib,$name,*
862	    foreach jid $special_list($xlib,$name) {
863		set cboxes($xlib,$name,$jid) 1
864	    }
865	}
866    }
867
868    if {$status == 1} {
869	# error
870	MessageDlg .privacy_list_err -aspect 50000 -icon error \
871	    -message [format $send_messages($name) [error_to_string $msg]] \
872	    -type user -buttons ok -default 0 -cancel 0
873	return
874    }
875
876    switch -- $name {
877	ignore -
878	conference -
879	subscription {
880	    # Some inefficiency here. We load three lists twice.
881	    join_lists $xlib "i-am-visible-list" \
882		       {ignore-list invisible-list conference-list subscription-list} \
883		       {allow {} {}} -command #
884	    join_lists $xlib "i-am-invisible-list" \
885		       {ignore-list visible-list conference-list subscription-list} \
886		       {deny {} {presence-out iq}} -command #
887	}
888	invisible {
889	    join_lists $xlib "i-am-visible-list" \
890		       {ignore-list invisible-list conference-list subscription-list} \
891		       {allow {} {}} -command #
892	}
893	visible {
894	    join_lists $xlib "i-am-invisible-list" \
895		       {ignore-list visible-list conference-list subscription-list} \
896		       {deny {} {presence-out iq}} -command #
897	}
898    }
899
900    # ejabberd behaves correctly and applies privacy lists before
901    # routing any subsequent packet, so we haven't to wait for iq reply
902    # before sending presence. What about other servers?
903    if {$userstatus == "invisible"} {
904	set status available
905    } else {
906	set status $userstatus
907    }
908
909    set tstatus $textstatus
910
911    foreach jid $postitems {
912	send_presence $xlib $status -to $jid -status $tstatus
913    }
914}
915
916
917proc privacy::join_lists {xlib name lists fallbacks args} {
918    set items {}
919
920    # Appending myself to the list to make sure we can communicate
921    # between own resources
922    lappend items [list type   jid \
923			value  [connection_bare_jid $xlib] \
924			action allow]
925
926    foreach ln $lists {
927	set status [catch {::xmpp::privacy::requestItems $xlib $ln} ritems]
928
929	if {$status == 3} {
930	    # abort
931	    return
932	}
933
934	if {$status == 0} {
935	    # !ok
936	    set items [concat $items $ritems]
937	}
938    }
939
940    foreach {action vars stanzas} $fallbacks {
941	lappend items [concat [list action $action stanzas $stanzas] $vars]
942    }
943
944    eval { ::xmpp::privacy::sendItems $xlib $name $items } $args
945}
946
947
948proc privacy::dropcmd {target source X Y op type data} {
949    add_special_jid $target [lindex $data 1]
950}
951
952
953proc privacy::select_and_popup_menu {f x y} {
954    set index [$f index @$x,$y]
955    $f selection clear 0 end
956    $f selection set $index
957
958    if {[winfo exists [set m .privacy_list_popupmenu]]} {
959	destroy $m
960    }
961
962    menu $m -tearoff 0
963    $m add command -label [::msgcat::mc "Remove from list"] \
964	-command [list $f delete $index]
965    tk_popup $m [winfo pointerx .] [winfo pointery .]
966}
967
968
969proc privacy::fill_edit_special_list {fr name items} {
970    set values {}
971    foreach item $items {
972	set type [::xmpp::xml::getAttr $item type]
973	if {$type != "jid"} continue
974	lappend values [::xmpp::xml::getAttr $item value]
975    }
976
977    eval [list $fr insert end] [lrmdups [lsort -dictionary $values]]
978}
979
980
981proc privacy::add_special_jid_entry {f entry} {
982    set item [$entry get]
983    $entry delete 0 end
984
985    add_special_jid $f $item
986}
987
988
989proc privacy::add_special_jid {f item} {
990    set values [$f get 0 end]
991    lappend values $item
992    set values [lrmdups [lsort -dictionary $values]]
993
994    set index [lsearch -exact $values $item]
995
996    $f delete 0 end
997    eval [list $f insert end] $values
998    $f selection set $index
999}
1000
1001###############################################################################
1002#
1003# During connect try to activate "i-am-visible-list" privacy list
1004# If it's not found then create and activate it
1005# If activation or creation fails then terminate connect with error message
1006#
1007
1008proc privacy::activate_privacy_list {depth xlib} {
1009    variable options
1010
1011    set_status [::msgcat::mc "Waiting for activating privacy list"]
1012    debugmsg privacy "requested privacy list activation"
1013
1014    set status [catch {send_default_or_active_list $xlib "i-am-visible-list" active} msg]
1015
1016    debugmsg privacy "setting i-am-visible-list as default: $status $msg"
1017
1018    switch -- $status {
1019	0 {
1020	    # ok
1021	    set_status [::msgcat::mc "Privacy list is activated"]
1022	    set_supported $xlib
1023	}
1024	1 {
1025	    # error
1026	    switch -- [lindex [error_type_condition $msg] 1] {
1027		feature-not-implemented {
1028		    # Privacy lists aren't implemented
1029		    # Give up
1030		    set_status \
1031			[::msgcat::mc "Privacy lists are not implemented"]
1032		}
1033		service-unavailable -
1034		recipient-unavailable {
1035		    # Privacy lists are unavailable
1036		    # Give up
1037		    set_status \
1038			[::msgcat::mc "Privacy lists are unavailable"]
1039		}
1040		item-not-found {
1041		    if {$depth >= 1} {
1042			# After successfully (!) created list it
1043			# mustn't be possible
1044			# TODO: error message
1045			return
1046		    }
1047		    # There's no required privacy list
1048		    # Create it
1049		    set_status \
1050			[::msgcat::mc "Creating default privacy list"]
1051
1052		    set status1 \
1053			[catch {join_lists $xlib "i-am-visible-list" \
1054			    {ignore-list invisible-list conference-list subscription-list} \
1055			    {allow {} {}}} msg1]
1056
1057		    debugmsg privacy "joining i-am-visible-list: $status1 $msg1"
1058
1059		    switch -- $status1 {
1060			0 {
1061			    # ok
1062			    # Activate newly created list
1063			    set_supported $xlib
1064			    return [activate_privacy_list [expr {$depth + 1}] \
1065							  $xlib]
1066			}
1067			1 {
1068			    # error
1069			    # Disconnect with error message
1070			    set_status \
1071				[::msgcat::mc "Privacy list is not created"]
1072
1073			    NonmodalMessageDlg .privacy_list_error[psuffix $xlib] \
1074				-aspect 50000 -icon error \
1075				-title [::msgcat::mc "Privacy lists error"] \
1076				-message \
1077				    [::msgcat::mc \
1078					"Creating default privacy list failed:\
1079					 %s\n\nTry to reconnect. If problem\
1080					 persists, you may want to disable privacy\
1081					 list activation at start" \
1082				    [error_to_string $msg1]]
1083
1084			    logout $xlib
1085
1086			    # Break connected_hook
1087			    return stop
1088			}
1089			default {
1090			    # abort
1091			    set_status \
1092				[::msgcat::mc "Privacy list is not created"]
1093
1094			    # Break connected_hook
1095			    return stop
1096			}
1097		    }
1098		}
1099		default {
1100		    # Something wrong
1101		    # Disconnect with error message
1102		    set_status \
1103			[::msgcat::mc "Privacy list is not activated"]
1104
1105		    NonmodalMessageDlg .privacy_list_error[psuffix $xlib] \
1106			-aspect 50000 -icon error \
1107			-title [::msgcat::mc "Privacy lists error"] \
1108			-message \
1109			    [::msgcat::mc \
1110				"Activating privacy list failed:\
1111				 %s\n\nTry to reconnect. If problem\
1112				 persists, you may want to disable privacy\
1113				 list activation at start" \
1114			    [error_to_string $msg]]
1115
1116		    logout $xlib
1117
1118		    # Break connected_hook
1119		    return stop
1120		}
1121	    }
1122	}
1123	default {
1124	    # abort
1125	    set_status [::msgcat::mc "Privacy list is not activated"]
1126
1127	    # Break connected_hook
1128	    return stop
1129	}
1130    }
1131}
1132
1133##########################################################################
1134
1135proc privacy::activate_privacy_list_at_startup {xlib} {
1136    variable options
1137
1138    if {$options(activate_at_startup)} {
1139	activate_privacy_list 0 $xlib
1140    }
1141}
1142
1143hook::add connected_hook \
1144    [namespace current]::privacy::activate_privacy_list_at_startup 1
1145
1146##########################################################################
1147
1148proc privacy::is_supported {xlib} {
1149    variable supported
1150
1151    expr {[info exists supported($xlib)] && $supported($xlib)}
1152}
1153
1154proc privacy::set_supported {xlib} {
1155    variable supported
1156
1157    set supported($xlib) 1
1158}
1159
1160proc privacy::clear_supported {xlib} {
1161    variable supported
1162
1163    array unset supported $xlib
1164}
1165
1166hook::add disconnected_hook [namespace current]::privacy::clear_supported
1167
1168###############################################################################
1169
1170proc privacy::create_menu {m xlib jid} {
1171    variable menu_messages
1172    variable special_list
1173    variable cboxes
1174
1175    set rjid [roster::find_jid $xlib $jid]
1176
1177    if {$rjid == ""} {
1178 	set rjid [::xmpp::jid::stripResource $jid]
1179    }
1180
1181    if {![is_supported $xlib] || \
1182	    [chat::is_groupchat [chat::chatid $xlib $rjid]]} {
1183	set state disabled
1184    } else {
1185	set state normal
1186    }
1187
1188    set mm [menu $m.privacy_menu -tearoff 0]
1189
1190    foreach name {invisible ignore} {
1191	if {![info exists special_list($xlib,$name)]} {
1192	    set special_list($xlib,$name) {}
1193	}
1194
1195	if {[lsearch -exact $special_list($xlib,$name) $rjid] >= 0} {
1196	    set cboxes($xlib,$name,$rjid) 1
1197	}
1198
1199	$mm add checkbutton -label $menu_messages($name) \
1200	    -variable [namespace current]::cboxes($xlib,$name,$rjid) \
1201	    -command [list [namespace current]::update_special_list \
1202			   $xlib $name $rjid]
1203    }
1204
1205    $m add cascade -label [::msgcat::mc "Privacy rules"] \
1206		  -menu $mm \
1207		  -state $state
1208}
1209
1210hook::add chat_create_user_menu_hook \
1211	  [namespace current]::privacy::create_menu 79
1212hook::add roster_service_popup_menu_hook \
1213	  [namespace current]::privacy::create_menu 79
1214hook::add roster_jid_popup_menu_hook \
1215	  [namespace current]::privacy::create_menu 79
1216
1217
1218###############################################################################
1219
1220proc privacy::update_special_list {xlib name jid} {
1221    variable cboxes
1222
1223    if {[info exists cboxes($xlib,$name,$jid)] && $cboxes($xlib,$name,$jid)} {
1224	add_to_special_list $xlib $name $jid
1225    } else {
1226	remove_from_special_list $xlib $name $jid
1227    }
1228}
1229
1230###############################################################################
1231
1232proc privacy::add_to_special_list {xlib name jid} {
1233    variable special_list
1234
1235    if {![info exists special_list($xlib,$name)]} {
1236	set special_list($xlib,$name) {}
1237    }
1238
1239    set idx [lsearch -exact $special_list($xlib,$name) $jid]
1240
1241    if {$idx < 0} {
1242	send_special_list $xlib $name \
1243			  [linsert $special_list($xlib,$name) 0 $jid]
1244    }
1245}
1246
1247###############################################################################
1248
1249proc privacy::remove_from_special_list {xlib name jid} {
1250    variable special_list
1251
1252    if {![info exists special_list($xlib,$name)]} {
1253	set special_list($xlib,$name) {}
1254    }
1255
1256    set idx [lsearch -exact $special_list($xlib,$name) $jid]
1257
1258    if {$idx >= 0} {
1259	send_special_list $xlib $name \
1260			  [lreplace $special_list($xlib,$name) $idx $idx]
1261    }
1262}
1263
1264###############################################################################
1265
1266proc privacy::process_push {xlib from name args} {
1267    switch -- $name {
1268	invisible-list {
1269	    reload_special_list $xlib invisible
1270	}
1271	visible-list {
1272	    reload_special_list $xlib visible
1273	}
1274	ignore-list {
1275	    reload_special_list $xlib ignore
1276	}
1277	conference-list {
1278	    reload_special_list $xlib conference
1279	}
1280	subscription-list {
1281	    reload_subscription_list $xlib
1282	}
1283    }
1284    return {result {}}
1285}
1286
1287::xmpp::privacy::register -command [namespace current]::privacy::process_push
1288
1289###############################################################################
1290
1291proc privacy::clear_list_vars {xlib} {
1292    variable special_list
1293    variable cboxes
1294
1295    array unset special_list $xlib,*
1296    array unset cboxes $xlib,*
1297}
1298
1299hook::add disconnected_hook [namespace current]::privacy::clear_list_vars
1300
1301###############################################################################
1302# Conference list should be loaded before any join group attempt is made
1303
1304proc privacy::get_conference_list {xlib} {
1305    set status [catch {::xmpp::privacy::requestItems $xlib conference-list} msg]
1306
1307    if {($status == 0) || \
1308	    ($status == 1 && \
1309	     [lindex [error_type_condition $msg] 1] == "item-not-found")} {
1310	set_supported $xlib
1311    }
1312
1313    switch -- $status {
1314	0 { set res ok }
1315	1 { set res error }
1316	default { set res abort }
1317    }
1318
1319    store_special_list $xlib conference $res $msg
1320}
1321
1322hook::add connected_hook [namespace current]::privacy::get_conference_list 2
1323
1324###############################################################################
1325
1326proc privacy::get_list_vars {xlib} {
1327    foreach name {invisible visible ignore} {
1328	reload_special_list $xlib $name
1329    }
1330    reload_subscription_list $xlib
1331}
1332
1333hook::add connected_hook [namespace current]::privacy::get_list_vars
1334
1335###############################################################################
1336
1337proc privacy::reload_special_list {xlib name} {
1338    ::xmpp::privacy::requestItems $xlib $name-list \
1339	    -command [namespace code [list store_special_list $xlib $name]]
1340}
1341
1342proc privacy::store_special_list {xlib name res child} {
1343    variable special_list
1344    variable cboxes
1345
1346    set special_list($xlib,$name) {}
1347    array unset cboxes $xlib,$name,*
1348
1349    if {$res != "ok"} return
1350
1351    foreach item $child {
1352	if {[::xmpp::xml::getAttr $item type] == "jid" && \
1353		[set jid [::xmpp::xml::getAttr $item value]] != ""} {
1354	    lappend special_list($xlib,$name) $jid
1355	    set cboxes($xlib,$name,$jid) 1
1356	}
1357    }
1358}
1359
1360###############################################################################
1361
1362proc privacy::reload_subscription_list {xlib} {
1363    ::xmpp::privacy::requestItems $xlib subscription-list \
1364	    -command [list [namespace current]::store_subscription_list $xlib]
1365}
1366
1367proc privacy::store_subscription_list {xlib res child} {
1368    variable accept_from_roster_only
1369
1370    set accept_from_roster_only 0
1371
1372    if {$res != "ok"} return
1373
1374    foreach item $child {
1375	if {[::xmpp::xml::getAttr $item type] == "subscription" && \
1376		[::xmpp::xml::getAttr $item value] == "none" && \
1377		[::xmpp::xml::getAttr $item action] == "deny"} {
1378	    set accept_from_roster_only 1
1379	}
1380    }
1381}
1382
1383###############################################################################
1384
1385proc privacy::first_supported {} {
1386    foreach xlib [connections] {
1387	if {[is_supported $xlib]} {
1388	    return $xlib
1389	}
1390    }
1391    return ""
1392}
1393
1394###############################################################################
1395
1396proc privacy::enable_menu {xlib} {
1397
1398    if {[first_supported] == ""} return
1399
1400    set m [.mainframe getmenu privacy]
1401    if {$::ifacetk::options(show_tearoffs)} {
1402	set start 1
1403    } else {
1404	set start 0
1405    }
1406    for {set i $start} {$i <= [$m index end]} {incr i} {
1407	catch {$m entryconfigure $i -state normal}
1408    }
1409}
1410
1411proc privacy::disable_menu {xlib} {
1412
1413    if {[first_supported] != ""} return
1414
1415    set m [.mainframe getmenu privacy]
1416    if {$::ifacetk::options(show_tearoffs)} {
1417	set start 1
1418    } else {
1419	set start 0
1420    }
1421    for {set i $start} {$i <= [$m index end]} {incr i} {
1422	catch {$m entryconfigure $i -state disabled}
1423    }
1424    $m entryconfigure [$m index [::msgcat::mc "Activate lists at startup"]] \
1425       -state normal
1426}
1427
1428hook::add connected_hook [namespace current]::privacy::enable_menu
1429hook::add disconnected_hook [namespace current]::privacy::disable_menu
1430hook::add finload_hook [list [namespace current]::privacy::disable_menu {}]
1431
1432###############################################################################
1433
1434# vim:ts=8:sw=4:sts=4:noet
1435