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