# $Id: privacy.tcl 1425 2008-05-18 07:29:04Z sergei $
#
# Privacy lists support (RFC 3921, section 10)
#

namespace eval privacy {
    variable options
    variable seq 0

    array set req_messages \
	[list ignore     [::msgcat::mc "Requesting ignore list: %s"] \
	      invisible  [::msgcat::mc "Requesting invisible list: %s"] \
	      visible    [::msgcat::mc "Requesting visible list: %s"] \
	      conference [::msgcat::mc "Requesting conference list: %s"]]

    array set send_messages \
	[list ignore       [::msgcat::mc "Sending ignore list: %s"] \
	      invisible    [::msgcat::mc "Sending invisible list: %s"] \
	      visible      [::msgcat::mc "Sending visible list: %s"] \
	      conference   [::msgcat::mc "Sending conference list: %s"] \
	      subscription [::msgcat::mc "Changing accept messages from roster only: %s"]]

    array set edit_messages \
	[list ignore     [::msgcat::mc "Edit ignore list"] \
	      invisible  [::msgcat::mc "Edit invisible list"] \
	      visible    [::msgcat::mc "Edit visible list"] \
	      conference [::msgcat::mc "Edit conference list"]]

    array set menu_messages \
	[list ignore     [::msgcat::mc "Ignore list"] \
	      invisible  [::msgcat::mc "Invisible list"] \
	      visible    [::msgcat::mc "Visible list"]]

    variable accept_from_roster 0

    custom::defgroup Privacy \
	[::msgcat::mc "Blocking communication (XMPP privacy lists) options."] \
	-group Tkabber

    custom::defvar options(activate_at_startup) 1 \
	[::msgcat::mc "Activate visible/invisible/ignore/conference lists\
		       before sending initial presence."] \
	-type boolean -group Privacy
}

###############################################################################
#
# Manual rules editing block
#

proc privacy::request_lists {args} {

    foreach {opt val} $args {
	switch -- $opt {
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	set connid [first_supported]
    }
    if {$connid == ""} return

    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)]] \
	-command [list [namespace current]::open_dialog $connid] \
	-connection $connid
}


proc privacy::on_destroy_dialog {w W} {
    variable data

    if {$w != $W} return
    
    catch { array unset data }
}

proc privacy::open_dialog {connid res child} {
    if {[cequal $res ERR]} {
	MessageDlg .privacy_err -aspect 50000 -icon error \
	    -message [::msgcat::mc "Requesting privacy rules: %s" \
			  [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    set w .privacy

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -title [::msgcat::mc "Privacy lists"] \
	-modal none -separator 1 -anchor e \
	-default 0 -cancel 1

    bind $w <Destroy> [list [namespace current]::on_destroy_dialog $w %W]

    $w add -text [::msgcat::mc "Send"] \
	-command [list [namespace current]::send_lists $connid $w]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]

    set f [$w getframe]

    set hf [frame $w.hf]
    pack $hf -side bottom

    set tools [frame $f.tools]
    pack $tools -side bottom -fill x -padx 1m
    
    set sw [ScrolledWindow $w.sw -scrollbar vertical]
    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
    pack $sw -side bottom -expand yes -fill both -in $f -pady 1m -padx 1m
    set lf [$sf getframe]
    $sw setwidget $sf

    set addlist [button $tools.addlist \
		     -text [::msgcat::mc "Add list"] \
		     -command [list [namespace current]::add_list \
				   $connid $tools $lf "" {}]]
    pack $addlist -side right -padx 1m

    set default [radiobutton $tools.default \
		     -text [::msgcat::mc "No default list"] \
		     -variable [namespace current]::data(default) \
		     -value "\u0000"]
    pack $default -side left -padx 1m

    set active [radiobutton $tools.active \
		    -text [::msgcat::mc "No active list"] \
		    -variable [namespace current]::data(active) \
		    -value "\u0000"]
    pack $active -side left -padx 1m

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    fill_lists $connid $hf $lf $children

    $w draw
}


proc privacy::fill_lists {connid hf f items} {
    variable data

    grid [label $f.n -text [::msgcat::mc "List name"] -width 20] \
	-row 0 -column 0 -sticky we -padx 1m
    grid [label $f.d -text [::msgcat::mc "Default"]] \
	-row 0 -column 1 -sticky we -padx 1m
    grid [label $f.a -text [::msgcat::mc "Active"]] \
	-row 0 -column 2 -sticky we -padx 1m

    grid columnconfigure $f 0 -weight 1
    grid columnconfigure $f 1 -weight 1
    grid columnconfigure $f 2 -weight 1
    grid columnconfigure $f 3 -weight 1
    grid columnconfigure $f 4 -weight 1

    set data(active) "\u0000"
    set data(default) "\u0000"
    set data(nlists) 0
    set i 0
    foreach item $items {
	jlib::wrapper:splitxml $item tag vars isempty chdata children
	switch -- x$tag {
	    xdefault {
		set data(default) [jlib::wrapper:getattr $vars name]
	    }
	    xactive {
		set data(active) [jlib::wrapper:getattr $vars name]
	    }
	    xlist {
		set name [jlib::wrapper:getattr $vars name]

		add_list $connid $hf $f $name $children
	    }
	}
    }
}


proc privacy::remove_list {lf ln} {
    variable data

    destroy $lf.name$ln
    destroy $lf.active$ln
    destroy $lf.default$ln
    destroy $lf.edit$ln
    destroy $lf.remove$ln
    set data(nitems,$ln) 0
    set data(newname,$ln) ""
}

proc privacy::::on_change_list_name {lf i args} {
    variable data

    set name $data(newname,$i)

    if {$data(default) == $data(name,$i)} {
	set data(default) $name
    }
    if {$data(active) == $data(name,$i)} {
	set data(active) $name
    }

    if {[winfo exists $lf.default$i] && [winfo exists $lf.active$i]} {
	$lf.default$i configure -value $name
	$lf.active$i configure -value $name
    }
    if {$name != ""} {
	set data(name,$i) $name
    }
}

proc privacy::add_list {connid hf lf name children} {
    variable data

    set i $data(nlists)

    if {$name == ""} {
	set name "list$i"
	send_new_list $connid $name
    }

    set data(name,$i) $name
    set data(newname,$i) $name

    trace variable [namespace current]::data(newname,$i) w \
	[list [namespace current]::on_change_list_name $lf $i]

    set lname [label $lf.name$i \
		   -text $name \
		   -textvariable [namespace current]::data(name,$i)]
    set default [radiobutton $lf.default$i \
		     -variable [namespace current]::data(default) \
		     -value $name]
    set active [radiobutton $lf.active$i \
		    -variable [namespace current]::data(active) \
		    -value $name]
    set remove [button $lf.remove$i \
		    -text [::msgcat::mc "Remove list"] \
		    -command [list [namespace current]::remove_list $lf $i]]
    set edit [button $lf.edit$i \
		  -text [::msgcat::mc "Edit list"] \
		  -command [list [namespace current]::edit_list $connid $lf $i]]
    
    set row [expr {$i + 1}]
    grid $lname   -row $row -column 0 -stick w  -padx 1m
    grid $default -row $row -column 1 -stick we -padx 1m
    grid $active  -row $row -column 2 -stick we -padx 1m
    grid $edit    -row $row -column 3 -stick we -padx 1m
    grid $remove  -row $row -column 4 -stick we -padx 1m

    update idletasks
    $hf configure \
	-width [expr {[winfo reqwidth $lf] + [winfo pixels $lf 1c]}]

    incr data(nlists)
}


proc privacy::edit_list {connid lf ln} {
    variable data

    set name $data(name,$ln)

    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag list \
				 -vars [list name $name]]]] \
	-command [list [namespace current]::edit_list_dialog $connid $ln $name] \
	-connection $connid
}


proc privacy::edit_list_dialog {connid ln name res child} {
    if {[cequal $res ERR]} {
	MessageDlg .privacy_list_err -aspect 50000 -icon error \
	    -message [::msgcat::mc "Requesting privacy list: %s" \
			  [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	set child [jlib::wrapper:createtag query \
		       -vars [list xmlns $::NS(privacy)] \
		       -subtags [list [jlib::wrapper:createtag list \
					   -vars [list name $name]]]]
    }

    set w .privacy_list

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -title [::msgcat::mc "Edit privacy list"] \
	-separator 1 -anchor e \
	-default 0 -cancel 1

    $w add -text [::msgcat::mc "Send"] \
	-command [list [namespace current]::send_list $connid $ln $w]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]

    set f [$w getframe]

    set tools [frame $f.tools]
    pack $tools -side bottom -fill x

    set hf [frame $w.hf]
    pack $hf -side bottom

    set sw [ScrolledWindow $w.sw -scrollbar vertical]
    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
    set lf [$sf getframe]
    pack $sw -side top -expand yes -fill both -in $f -pady 1m
    $sw setwidget $sf

    set additem [button $tools.aditem \
		     -text [::msgcat::mc "Add item"] \
		     -command \
		     [list [namespace current]::add_item \
			  $lf.items "none" "" "allow" 1 1 1 1]]
    pack $additem -side right -padx 1m

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    fill_edit_lists $lf $children

    update idletasks
    $hf configure \
	-width [expr {[winfo reqwidth $lf] + [winfo pixels $lf 1c]}]

    $w draw
}


proc privacy::fill_edit_lists {f items} {
    variable data

    foreach item $items {
	if {$item != ""} {
	    jlib::wrapper:splitxml $item tag vars isempty chdata children
	    if {$tag == "list"} {
		set name [jlib::wrapper:getattr $vars name]
		fill_edit_list $f $name $children
		break
	    }
	}
    }
}


proc privacy::compare {item1 item2} {
    jlib::wrapper:splitxml $item1 tag vars isempty chdata children
    set order1 [jlib::wrapper:getattr $vars order]
    jlib::wrapper:splitxml $item2 tag vars isempty chdata children
    set order2 [jlib::wrapper:getattr $vars order]

    return [expr {$order1 > $order2}]
}


proc privacy::fill_edit_list {fr name items} {
    variable data

    set data(listname) $name
    set data(listnewname) $name

    set fname [frame $fr.name]
    pack $fname -side top -fill x
    label $fname.lname -text [string trimright [::msgcat::mc "Name: "]]
    entry $fname.name \
	-textvariable [namespace current]::data(listnewname)
    pack $fname.lname -side left -anchor w
    pack $fname.name -side left -fill x -expand yes

    set f [frame $fr.items]
    pack $f -side top -fill both -expand yes

    label $f.ltype        -text [::msgcat::mc "Type"]
    label $f.lvalue       -text [::msgcat::mc "Value"]
    label $f.laction      -text [::msgcat::mc "Action"]
    label $f.lmessage     -text [::msgcat::mc "Message"]
    label $f.lpresencein  -text [::msgcat::mc "Presence-in"]
    label $f.lpresenceout -text [::msgcat::mc "Presence-out"]
    label $f.liq          -text [::msgcat::mc "IQ"]
    grid $f.ltype        -row 0 -column 0 -sticky we -padx 0.5m
    grid $f.lvalue       -row 0 -column 1 -sticky we -padx 0.5m
    grid $f.laction      -row 0 -column 2 -sticky we -padx 0.5m
    grid $f.lmessage     -row 0 -column 3 -sticky we -padx 0.5m
    grid $f.lpresencein  -row 0 -column 4 -sticky we -padx 0.5m
    grid $f.lpresenceout -row 0 -column 5 -sticky we -padx 0.5m
    grid $f.liq          -row 0 -column 6 -sticky we -padx 0.5m
    grid columnconfig $f 1 -weight 1

    set data(listnitems) 0
    foreach item [lsort -command [namespace current]::compare $items] {
	jlib::wrapper:splitxml $item tag vars isempty chdata children

	set type   [jlib::wrapper:getattr $vars type]
	if {$type == ""} {
	    set type none
	}
	set value  [jlib::wrapper:getattr $vars value]
	set action [jlib::wrapper:getattr $vars action]

	set all 1
	array set tmp [list message 0 presence-in 0 presence-out 0 iq 0]
	foreach child $children {
	    jlib::wrapper:splitxml $child tag1 vars1 isempty1 chdata1 children1
	    switch -- $tag1 {
		message -
		presence-in -
		presence-out -
		iq {
		    set tmp($tag1) 1
		    set all 0
		}
	    }
	}
	if {$all} {
	    array set tmp [list message 1 presence-in 1 presence-out 1 iq 1]
	}

	add_item $f $type $value $action \
	    $tmp(message) $tmp(presence-in) $tmp(presence-out) $tmp(iq)
    }
}


proc privacy::add_item {f type value action message presencein presenceout iq} {
    variable data

    set i $data(listnitems)

    entry $f.value$i \
	-textvariable [namespace current]::data(value,$i)
    ComboBox $f.type$i \
	-values {none jid group subscription} \
	-editable no \
	-width 12 \
	-textvariable [namespace current]::data(type,$i)
    ComboBox $f.action$i \
	-values {allow deny} \
	-editable no \
	-width 5 \
	-textvariable [namespace current]::data(action,$i)
    checkbutton $f.message$i \
	-variable [namespace current]::data(message,$i) \
	-command [list [namespace current]::update_checkbuttons $i]
    checkbutton $f.presencein$i \
	-variable [namespace current]::data(presencein,$i) \
	-command [list [namespace current]::update_checkbuttons $i]
    checkbutton $f.presenceout$i \
	-variable [namespace current]::data(presenceout,$i) \
	-command [list [namespace current]::update_checkbuttons $i]
    checkbutton $f.iq$i \
	-variable [namespace current]::data(iq,$i) \
	-command [list [namespace current]::update_checkbuttons $i]
    button $f.moveup$i -text [::msgcat::mc "Up"] \
	-command [list [namespace current]::move_item_up $f $i]
    button $f.movedown$i -text [::msgcat::mc "Down"] \
	-command [list [namespace current]::move_item_down $f $i]
    button $f.remove$i -text [::msgcat::mc "Remove"] \
	-command [list [namespace current]::remove_item $f $i]

    set data(type,$i)        $type
    set data(value,$i)       $value
    set data(action,$i)      $action
    set data(message,$i)     $message
    set data(presencein,$i)  $presencein
    set data(presenceout,$i) $presenceout
    set data(iq,$i)          $iq

    set row [expr {$i + 1}]
    grid $f.type$i        -row $row -column 0 -sticky ew -padx 0.5m
    grid $f.value$i       -row $row -column 1 -sticky ew -padx 0.5m
    grid $f.action$i      -row $row -column 2 -sticky ew -padx 0.5m
    grid $f.message$i     -row $row -column 3 -sticky ew -padx 0.5m
    grid $f.presencein$i  -row $row -column 4 -sticky ew -padx 0.5m
    grid $f.presenceout$i -row $row -column 5 -sticky ew -padx 0.5m
    grid $f.iq$i          -row $row -column 6 -sticky ew -padx 0.5m
    grid $f.moveup$i      -row $row -column 7 -sticky ew -padx 0.5m
    grid $f.movedown$i    -row $row -column 8 -sticky ew -padx 0.5m
    grid $f.remove$i      -row $row -column 9 -sticky ew -padx 0.5m

    incr data(listnitems)
    update_button_states $f
}


proc privacy::update_checkbuttons {i} {
    variable data

    if {!$data(message,$i) && !$data(presencein,$i) && \
	    !$data(presenceout,$i) && !$data(iq,$i)} {
	set data(message,$i) 1
	set data(presencein,$i) 1
	set data(presenceout,$i) 1
	set data(iq,$i) 1
    }
}


proc privacy::update_button_states {f} {
    variable data

    set numrows 0
    set row 0
    for {set i 0} {$i < $data(listnitems)} {incr i} {
	if {$data(type,$i) != "remove"} {
	    $f.remove$i configure -state normal
	    incr numrows
	    set row $i
	}
    }
    if {$numrows == 1} {
	$f.remove$row configure -state disabled
    }
}


proc privacy::move_item_up {f i} {
    variable data

    set j $i
    incr j -1
    while {$j >= 0 && $data(type,$j) == "remove"} {
	incr j -1
    }

    if {$j >= 0} {
	switch_items $f $i $j
    }
}


proc privacy::move_item_down {f i} {
    variable data

    set j $i
    incr j 1
    while {$j < $data(listnitems) && $data(type,$j) == "remove"} {
	incr j 1
    }

    if {$j < $data(listnitems)} {
	switch_items $f $i $j
    }
}


proc privacy::switch_items {f i j} {
    variable data

    set type        $data(type,$i)
    set value       $data(value,$i)
    set action      $data(action,$i)
    set message     $data(message,$i)
    set presencein  $data(presencein,$i)
    set presenceout $data(presenceout,$i)
    set iq          $data(iq,$i)
    
    set data(type,$i)        $data(type,$j)
    set data(value,$i)       $data(value,$j)
    set data(action,$i)      $data(action,$j)
    set data(message,$i)     $data(message,$j)
    set data(presencein,$i)  $data(presencein,$j)
    set data(presenceout,$i) $data(presenceout,$j)
    set data(iq,$i)          $data(iq,$j)
    
    set data(type,$j)        $type
    set data(value,$j)       $value
    set data(action,$j)      $action
    set data(message,$j)     $message
    set data(presencein,$j)  $presencein
    set data(presenceout,$j) $presenceout
    set data(iq,$j)          $iq
}


proc privacy::remove_item {f i} {
    variable data

    destroy $f.type$i
    destroy $f.value$i
    destroy $f.action$i
    destroy $f.message$i
    destroy $f.presencein$i
    destroy $f.presenceout$i
    destroy $f.iq$i
    destroy $f.moveup$i
    destroy $f.movedown$i
    destroy $f.remove$i

    set data(type,$i) remove
    set data(value,$i) ""
    set data(action,$i) allow

    update_button_states $f
}


proc privacy::send_list_iq {name items args} {
    set cmd jlib::noop
    foreach {opt val} $args {
	switch -- $opt {
	    -command { set cmd $val }
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	return -code error "Option -connection is mandatory"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag list \
				 -vars [list name $name] \
				 -subtags $items]]] \
	-command $cmd \
	-connection $connid
}


proc privacy::send_new_list {connid name} {
    send_list_iq $name \
	[list [jlib::wrapper:createtag item \
		   -vars [list action allow order 0]]] \
	-connection $connid
}


proc privacy::send_list {connid ln w} {
    variable data

    set name $data(listnewname)
    send_list_iq $name [list_items] -connection $connid

    if {$name != $data(listname)} {
	if {$data(default) == $data(listname)} {
	    send_default_or_active_list $name default -connection $connid
	}
	send_list_iq $data(listname) {} -connection $connid
	set data(newname,$ln) $name
    }

    destroy $w
}


proc privacy::send_lists {connid w} {
    variable data

    for {set i 0} {$i < $data(nlists)} {incr i} {
        if {$data(newname,$i) == ""} {
            send_list_iq $data(name,$i) {} -connection $connid
        }
    }

    send_default_or_active_list $data(active) active -connection $connid
    send_default_or_active_list $data(default) default -connection $connid

    destroy $w
}


proc privacy::list_items {} {
    variable data

    set items {}
    for {set i 0} {$i < $data(listnitems)} {incr i} {
	if {$data(type,$i) == "remove"} continue

	set vars [list action $data(action,$i) order $i]
	if {$data(type,$i) != "none"} {
	    lappend vars type $data(type,$i) value $data(value,$i)
	}

	set children {}
	if {$data(message,$i)} {
	    lappend children [jlib::wrapper:createtag message]
	}
	if {$data(presencein,$i)} {
	    lappend children [jlib::wrapper:createtag presence-in]
	}
	if {$data(presenceout,$i)} {
	    lappend children [jlib::wrapper:createtag presence-out]
	}
	if {$data(iq,$i)} {
	    lappend children [jlib::wrapper:createtag iq]
	}
	if {[llength $children] == 4} {
	    set children {}
	}

	lappend items [jlib::wrapper:createtag item \
			   -vars $vars \
			   -subtags $children]
    }
    return $items
}

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

proc privacy::send_default_or_active_list {name tag args} {
    set cmd jlib::noop
    foreach {opt val} $args {
	switch -- $opt {
	    -command { set cmd $val }
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	return -code error "Option -connection is mandatory"
    }

    if {$name != "\u0000"} {
	set vars [list name $name]
    } else {
	set vars {}
    }
    jlib::send_iq set \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag $tag \
				 -vars $vars]]] \
	-command $cmd \
	-connection $connid
}

###############################################################################
#
# Visible, invisible, ignore, conference list block
#

proc privacy::edit_special_list {name args} {
    foreach {opt val} $args {
	switch -- $opt {
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	set connid [first_supported]
    }
    if {$connid == ""} return

    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag list \
				 -vars [list name "$name-list"]]]] \
	-command [list [namespace current]::edit_special_list_dialog $connid $name] \
	-connection $connid
}


proc privacy::edit_special_list_dialog {connid name res child} {
    variable req_messages
    variable edit_messages

    if {[cequal $res ERR]} {
	if {[error_type_condition $child] != {cancel item-not-found}} {
	    MessageDlg .privacy_list_err -aspect 50000 -icon error \
		-message [format $req_messages($name) [error_to_string $child]] \
		-type user -buttons ok -default 0 -cancel 0
	    return
	}
	set child [jlib::wrapper:createtag query \
		       -vars [list xmlns $::NS(privacy)] \
		       -subtags [list [jlib::wrapper:createtag list \
					   -vars [list name "$name-list"]]]]
    }

    set w .privacy_list

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -title $edit_messages($name) \
	-modal none -separator 1 -anchor e \
	-default 0 -cancel 1

    $w add -text [::msgcat::mc "Send"] \
	-command [list [namespace current]::edit_special_list_enddialog \
		       $connid $w $name]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]

    set f [$w getframe]

    set tools [frame $f.tools]
    pack $tools -side bottom -fill x
    
    set sw [ScrolledWindow $w.sw]
    set lf [listbox $w.fields]
    pack $sw -side top -expand yes -fill both -in $f -pady 1m -padx 1m
    $sw setwidget $lf

    bind $lf <3> [list [namespace current]::select_and_popup_menu %W %x %y]

    set addentry [entry $tools.addentry]
    set additem [button $tools.additem \
		     -text [::msgcat::mc "Add JID"] \
		     -command \
		     [list [namespace current]::add_special_jid_entry $lf $addentry]]
    pack $additem -side right -padx 1m
    pack $addentry -side left -padx 1m -fill x -expand yes

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    fill_edit_special_lists $lf $children

    #update idletasks
    #$tools configure -width [winfo reqwidth $lf]

    DropSite::register $lf -dropcmd [list [namespace current]::dropcmd] \
        -droptypes {JID}

    $w draw
}


proc privacy::edit_special_list_enddialog {connid w name} {
    $w itemconfigure 0 -state disabled
    send_special_list $connid $name [$w.fields get 0 end]
    destroy $w
}

proc privacy::send_special_list {connid name items} {
    variable seq
    variable special_list
    variable cboxes

    if {![is_supported $connid]} {
	return
    }

    if {![info exists special_list($connid,$name)]} {
	set special_list($connid,$name) {}
    }

    set newitems {}
    foreach jid $items {
	if {[lsearch -exact $special_list($connid,$name) $jid] < 0} {
	    lappend newitems $jid
	}
    }

    set olditems {}
    foreach jid $special_list($connid,$name) {
	if {[lsearch -exact $items $jid] < 0} {
	    lappend olditems $jid
	}
    }

    switch -- $name {
	ignore {
	    set children {}
	    set action deny
	    foreach jid $newitems {
		send_custom_presence $jid unavailable -connection $connid
	    }
	    set postitems $olditems
	}
	invisible {
	    set children [list [jlib::wrapper:createtag presence-out]]
	    set action deny
	    foreach jid $newitems {
		send_custom_presence $jid unavailable -connection $connid
	    }
	    set postitems $olditems
	}
	visible {
	    # TODO: invisibility
	    set children [list [jlib::wrapper:createtag presence-out]]
	    set action allow
	    set postitems $newitems
	}
	conference {
	    set children {}
	    set action allow
	    set postitems {}
	}
    }

    set items1 {}
    set i 0
    foreach item $items {
	lappend items1 [jlib::wrapper:createtag item \
			    -vars [list type jid \
					value $item \
					action $action \
					order $i] \
			    -subtags $children]
	incr i
    }

    set s [incr seq]
    send_list_iq "$name-list" $items1 \
	-command [list [namespace current]::get_answer $s] \
	-connection $connid

    # We have to vwait because all privacy lists should be updated
    # before sending next stanzas
    lassign [wait_for_answer $s] res child

    update_tkabber_lists $connid $name $items $postitems $res $child
}

# subscription-list is responsible for blocking all messages
# not from the roster.
proc privacy::send_subscription_list {connid} {
    variable seq
    variable accept_from_roster_only

    if {![is_supported $connid]} {
	return
    }

    if {$accept_from_roster_only} {
	set items [list [jlib::wrapper:createtag item \
			     -vars [list type subscription \
					 value none \
					 action deny \
					 order 0]]]
    } else {
	set items {}
    }

    set s [incr seq]
    # If items aren't empty, we'll never send unavailable presence to
    # all users to whom directed presence was sent. Bug?
    send_list_iq "subscription-list" $items \
	-command [list [namespace current]::get_answer $s] \
	-connection $connid

    # We have to vwait because all privacy lists should be updated
    # before sending next stanzas
    lassign [wait_for_answer $s] res child

    update_tkabber_lists $connid subscription $items {} $res $child
}

proc privacy::on_accept_from_roster_only_change {args} {
    foreach {opt val} $args {
	switch -- $opt {
	    -connection { set connid $val }
	}
    }
    if {![info exists connid]} {
	set connid [first_supported]
    }
    if {$connid == ""} return

    send_subscription_list $connid
}

proc privacy::update_tkabber_lists {connid name items postitems res child} {
    global userstatus textstatus statusdesc
    variable send_messages
    variable special_list
    variable cboxes

    if {$res == "DISCONNECT"} return

    switch -- $name {
	subscription {
	    # Subscription list doesn't contain JIDs
	}
	default {
	    # Workaround for servers without privacy list support/push
	    if {$res == "OK"} {
		set special_list($connid,$name) $items
	    }
	    array unset cboxes $connid,$name,*
	    foreach jid $special_list($connid,$name) {
		set cboxes($connid,$name,$jid) 1
	    }
	}
    }

    if {$res == "ERR"} {
	MessageDlg .privacy_list_err -aspect 50000 -icon error \
	    -message [format $send_messages($name) [error_to_string $child]] \
	    -type user -buttons ok -default 0 -cancel 0
	return
    }

    switch -- $name {
	ignore -
	conference -
	subscription {
	    # Some inefficiency here. We load three lists twice.
	    join_lists $connid "i-am-visible-list" \
		       {ignore-list invisible-list conference-list subscription-list} \
		       {allow {} {}}
	    join_lists $connid "i-am-invisible-list" \
		       {ignore-list visible-list conference-list subscription-list} \
		       [list deny {} [list [jlib::wrapper:createtag presence-out]]]
	}
	invisible {
	    join_lists $connid "i-am-visible-list" \
		       {ignore-list invisible-list conference-list subscription-list} \
		       {allow {} {}}
	}
	visible {
	    join_lists $connid "i-am-invisible-list" \
		       {ignore-list visible-list conference-list subscription-list} \
		       [list deny {} [list [jlib::wrapper:createtag presence-out]]]
	}
    }

    # ejabberd behaves correctly and applies privacy lists before
    # routing any subsequent packet, so we haven't to wait for iq reply
    # before sending presence. What about other servers?
    if {$userstatus == "invisible"} {
	set status available
    } else {
	set status $userstatus
    }

    if {$textstatus == ""} {
	set tstatus $statusdesc($status)
    } else {
	set tstatus $textstatus
    }

    foreach jid $postitems {
	send_presence $status -to $jid -stat $tstatus -connection $connid
    }
}


proc privacy::join_lists {connid name lists fallbacks args} {
    variable litems

    set items {}
    set i 0

    # Appending myself to the list to make sure we can communicate
    # between own resources
    lappend items [jlib::wrapper:createtag item \
		       -vars [list type jid \
				   value [jlib::connection_bare_jid $connid] \
				   action allow \
				   order $i]]
    incr i

    foreach ln $lists {
	jlib::send_iq get \
	    [jlib::wrapper:createtag query \
		 -vars [list xmlns $::NS(privacy)] \
		 -subtags [list [jlib::wrapper:createtag list \
				     -vars [list name $ln]]]] \
	    -command [list [namespace current]::get_items $connid] \
	    -connection $connid

	vwait [namespace current]::litems($connid)

	foreach item $litems($connid) {
	    jlib::wrapper:splitxml $item tag vars isempty chdata children
	    catch { array unset tmp }
	    array set tmp $vars
	    set tmp(order) $i
	    lappend items [jlib::wrapper:createtag $tag \
			       -vars [array get tmp] \
			       -subtags $children]
	    incr i
	}
    }
    unset litems($connid)

    foreach {action vars subtags} $fallbacks {
	lappend items [jlib::wrapper:createtag item \
			   -vars [concat [list action $action order $i] $vars] \
			   -subtags $subtags]
    }

    eval { send_list_iq $name $items -connection $connid } $args
}


proc privacy::get_items {connid res child} {
    variable litems

    if {$res != "OK"} {
	set litems($connid) {}
	return
    }

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    jlib::wrapper:splitxml [lindex $children 0] tag vars isempty chdata children

    if {$tag == "list"} {
	set litems($connid) $children
    } else {
	set litems($connid) {}
    }
}


proc privacy::dropcmd {target source X Y op type data} {
    add_special_jid $target [lindex $data 1]
}


proc privacy::select_and_popup_menu {f x y} {
    set index [$f index @$x,$y]
    $f selection clear 0 end
    $f selection set $index

    if {[winfo exists [set m .privacy_list_popupmenu]]} {
	destroy $m
    }

    menu $m -tearoff 0
    $m add command -label [::msgcat::mc "Remove from list"] \
	-command [list $f delete $index]
    tk_popup $m [winfo pointerx .] [winfo pointery .]
}


proc privacy::fill_edit_special_lists {f items} {
    foreach item $items {
	if {$item != ""} {
	    jlib::wrapper:splitxml $item tag vars isempty chdata children
	    if {$tag == "list"} {
		set name [jlib::wrapper:getattr $vars name]
		fill_edit_special_list $f $name $children
		break
	    }
	}
    }
}


proc privacy::fill_edit_special_list {fr name items} {
    set values {}
    foreach item $items {
	jlib::wrapper:splitxml $item tag vars isempty chdata children

	set type   [jlib::wrapper:getattr $vars type]
	if {$type != "jid"} {
	    continue
	}
	lappend values [jlib::wrapper:getattr $vars value]
    }

    eval [list $fr insert end] [lrmdups [lsort -dictionary $values]]
}


proc privacy::add_special_jid_entry {f entry} {
    set item [$entry get]
    $entry delete 0 end

    add_special_jid $f $item
}


proc privacy::add_special_jid {f item} {
    set values [$f get 0 end]
    lappend values $item
    set values [lrmdups [lsort -dictionary $values]]

    set index [lsearch -exact $values $item]

    $f delete 0 end
    eval [list $f insert end] $values
    $f selection set $index
}

###############################################################################
#
# During connect try to activate "i-am-visible-list" privacy list
# If it's not found then create and activate it
# If activation or creation fails then terminate connect with error message
#

proc privacy::activate_privacy_list {depth connid} {
    variable seq
    variable options

    set_status [::msgcat::mc "Waiting for activating privacy list"]
    debugmsg privacy "requested privacy list activation"

    set s [incr seq]
    send_default_or_active_list "i-am-visible-list" active \
	-command [list [namespace current]::get_answer $s] \
	-connection $connid

    lassign [wait_for_answer $s] res child

    switch -- $res {
	"OK" {
	    set_status [::msgcat::mc "Privacy list is activated"]
	    set_supported $connid
	}
	"ERR" {
	    switch -- [lindex [error_type_condition $child] 1] {
		feature-not-implemented {
		    # Privacy lists aren't implemented
		    # Give up
		    set_status \
			[::msgcat::mc "Privacy lists are not implemented"]
		}
		service-unavailable -
		recipient-unavailable {
		    # Privacy lists are unavailable
		    # Give up
		    set_status \
			[::msgcat::mc "Privacy lists are unavailable"]
		}
		item-not-found {
		    if {$depth >= 1} {
			# After successfully (!) created list it
			# mustn't be possible
			# TODO: error message
			return
		    }
		    # There's no required privacy list
		    # Create it
		    set_status \
			[::msgcat::mc "Creating default privacy list"]

		    set s [incr seq]
		    join_lists $connid "i-am-visible-list" \
			{ignore-list invisible-list conference-list subscription-list} \
			{allow {} {}} \
			-command [list [namespace current]::get_answer $s]

		    lassign [wait_for_answer $s] res child

		    switch -- $res {
			"OK" {
			    # Activate newly created list
			    set_supported $connid
			    return [activate_privacy_list [expr {$depth + 1}] \
							  $connid]
			}
			"ERR" {
			    # Disconnect with error message
			    set_status \
				[::msgcat::mc "Privacy list is not created"]

			    NonmodalMessageDlg .privacy_list_error$connid \
				-aspect 50000 -icon error \
				-title [::msgcat::mc "Privacy lists error"] \
				-message \
				    [::msgcat::mc \
					"Creating default privacy list failed:\
					 %s\n\nTry to reconnect. If problem\
					 persists, you may want to disable privacy\
					 list activation at start" \
				    [error_to_string $child]]

			    logout $connid

			    # Break connected_hook
			    return stop
			}
			default {
			    # "DISCONNECT"
			    set_status \
				[::msgcat::mc "Privacy list is not created"]

			    # Break connected_hook
			    return stop
			}
		    }
		}
		default {
		    # Something wrong
		    # Disconnect with error message
		    set_status \
			[::msgcat::mc "Privacy list is not activated"]

		    NonmodalMessageDlg .privacy_list_error$connid \
			-aspect 50000 -icon error \
			-title [::msgcat::mc "Privacy lists error"] \
			-message \
			    [::msgcat::mc \
				"Activating privacy list failed:\
				 %s\n\nTry to reconnect. If problem\
				 persists, you may want to disable privacy\
				 list activation at start" \
			    [error_to_string $child]]

		    logout $connid

		    # Break connected_hook
		    return stop
		}
	    }
	}
	default {
	    # "DISCONNECT"
	    set_status [::msgcat::mc "Privacy list is not activated"]

	    # Break connected_hook
	    return stop
	}
    }
}

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

proc privacy::activate_privacy_list_at_startup {connid} {
    variable options

    if {$options(activate_at_startup)} {
	activate_privacy_list 0 $connid
    }
}

hook::add connected_hook \
    [namespace current]::privacy::activate_privacy_list_at_startup 1

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

proc privacy::get_answer {seq res child} {
    variable answer
    debugmsg privacy "got privacy list answer $seq $res $child"

    set answer($seq) [list $res $child]
}

proc privacy::wait_for_answer {seq} {
    variable answer

    vwait [namespace current]::answer($seq)
    set res $answer($seq)
    unset answer($seq)
    return $res
}

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

proc privacy::is_supported {connid} {
    variable supported

    expr {[info exists supported($connid)] && $supported($connid)}
}

proc privacy::set_supported {connid} {
    variable supported

    set supported($connid) 1
}

proc privacy::clear_supported {connid} {
    variable supported

    if {$connid == ""} {
	catch { array unset supported * }
    } else {
	catch { array unset supported $connid }
    }
}

hook::add disconnected_hook [namespace current]::privacy::clear_supported

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

proc privacy::create_menu {m connid jid} {
    variable menu_messages
    variable special_list
    variable cboxes

    set rjid [roster::find_jid $connid $jid]

    if {$rjid == ""} {
 	set rjid [node_and_server_from_jid $jid]
    }

    if {![is_supported $connid] || \
	    [chat::is_groupchat [chat::chatid $connid $rjid]]} {
	set state disabled
    } else {
	set state normal
    }

    set mm [menu $m.privacy_menu -tearoff 0]

    foreach name {invisible ignore} {
	if {![info exists special_list($connid,$name)]} {
	    set special_list($connid,$name) {}
	}

	if {[lsearch -exact $special_list($connid,$name) $rjid] >= 0} {
	    set cboxes($connid,$name,$rjid) 1
	}

	$mm add checkbutton -label $menu_messages($name) \
	    -variable [namespace current]::cboxes($connid,$name,$rjid) \
	    -command [list [namespace current]::update_special_list \
			   $connid $name $rjid]
    }

    $m add cascade -label [::msgcat::mc "Privacy rules"] \
		  -menu $mm \
		  -state $state
}

hook::add chat_create_user_menu_hook \
	  [namespace current]::privacy::create_menu 79
hook::add roster_service_popup_menu_hook \
	  [namespace current]::privacy::create_menu 79
hook::add roster_jid_popup_menu_hook \
	  [namespace current]::privacy::create_menu 79


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

proc privacy::update_special_list {connid name jid} {
    variable cboxes

    if {[info exists cboxes($connid,$name,$jid)] && $cboxes($connid,$name,$jid)} {
	add_to_special_list $connid $name $jid
    } else {
	remove_from_special_list $connid $name $jid
    }
}

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

proc privacy::add_to_special_list {connid name jid} {
    variable special_list

    if {![info exists special_list($connid,$name)]} {
	set special_list($connid,$name) {}
    }

    set idx [lsearch -exact $special_list($connid,$name) $jid]

    if {$idx < 0} {
	send_special_list $connid $name \
			  [linsert $special_list($connid,$name) 0 $jid]
    }
}

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

proc privacy::remove_from_special_list {connid name jid} {
    variable special_list

    if {![info exists special_list($connid,$name)]} {
	set special_list($connid,$name) {}
    }

    set idx [lsearch -exact $special_list($connid,$name) $jid]

    if {$idx >= 0} {
	send_special_list $connid $name \
			  [lreplace $special_list($connid,$name) $idx $idx]
    }
}

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

proc privacy::process_iq {connid from lang child} {
    if {$from != "" && \
	    !([string equal -nocase $from [jlib::connection_server $connid]] || \
	      [string equal -nocase $from [jlib::connection_bare_jid $connid]] || \
	      [string equal -nocase $from [jlib::connection_jid $connid]])} {
	return {error cancel not-allowed}
    }

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	switch -- $tag1 {
	    list {
		switch -- [jlib::wrapper:getattr $vars1 name] {
		    invisible-list {
			reload_special_list $connid invisible
		    }
		    visible-list {
			reload_special_list $connid visible
		    }
		    ignore-list {
			reload_special_list $connid ignore
		    }
		    conference-list {
			reload_special_list $connid conference
		    }
		    subscription-list {
			reload_subscription_list $connid
		    }
		}
	    }
	}
    }
    return {result {}}
}

iq::register_handler set query $::NS(privacy) \
		     [namespace current]::privacy::process_iq

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

proc privacy::clear_list_vars {connid} {
    variable special_list
    variable cboxes

    if {$connid == ""} {
	catch { array unset special_list * }
	catch { array unset cboxes * }
    } else {
	catch { array unset special_list $connid,* }
	catch { array unset cboxes $connid,* }
    }
}

hook::add disconnected_hook [namespace current]::privacy::clear_list_vars

###############################################################################
# Conference list should be loaded before any join group attempt is made

proc privacy::get_conference_list {connid} {
    variable seq

    set s [incr seq]
    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag list \
				 -vars [list name "conference-list"]]]] \
	-command [list [namespace current]::get_answer $s] \
	-connection $connid

    lassign [wait_for_answer $s] res child

    if {($res == "OK") || \
	    ($res == "ERR" && \
	     [lindex [error_type_condition $child] 1] == "item-not-found")} {
	set_supported $connid
    }

    store_special_list $connid conference $res $child
}

hook::add connected_hook [namespace current]::privacy::get_conference_list 2

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

proc privacy::get_list_vars {connid} {
    foreach name {invisible visible ignore} {
	reload_special_list $connid $name
    }
    reload_subscription_list $connid
}

hook::add connected_hook [namespace current]::privacy::get_list_vars

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

proc privacy::reload_special_list {connid name} {
    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag list \
				 -vars [list name "$name-list"]]]] \
	-command [list [namespace current]::store_special_list $connid $name] \
	-connection $connid
}

proc privacy::store_special_list {connid name res child} {
    variable special_list
    variable cboxes

    set special_list($connid,$name) {}
    array unset cboxes $connid,$name,*

    if {$res != "OK"} return

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    jlib::wrapper:splitxml [lindex $children 0] tag vars isempty chdata children

    if {$tag != "list"} return

    foreach item $children {
	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	if {[jlib::wrapper:getattr $vars1 type] == "jid" && \
		[set jid [jlib::wrapper:getattr $vars1 value]] != ""} {
	    lappend special_list($connid,$name) $jid
	    set cboxes($connid,$name,$jid) 1
	}
    }
}

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

proc privacy::reload_subscription_list {connid} {
    jlib::send_iq get \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(privacy)] \
	     -subtags [list [jlib::wrapper:createtag list \
				 -vars [list name "subscription-list"]]]] \
	-command [list [namespace current]::store_subscription_list $connid] \
	-connection $connid
}

proc privacy::store_subscription_list {connid res child} {
    variable accept_from_roster_only

    set accept_from_roster_only 0

    if {$res != "OK"} return

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    jlib::wrapper:splitxml [lindex $children 0] tag vars isempty chdata children

    if {$tag != "list"} return

    foreach item $children {
	jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	if {[jlib::wrapper:getattr $vars1 type] == "subscription" && \
		[jlib::wrapper:getattr $vars1 value] == "none" && \
		[jlib::wrapper:getattr $vars1 action] == "deny"} {
	    set accept_from_roster_only 1
	}
    }
}

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

proc privacy::first_supported {} {
    foreach connid [jlib::connections] {
	if {[is_supported $connid]} {
	    return $connid
	}
    }
    return ""
}

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

proc privacy::enable_menu {connid} {

    if {[first_supported] == ""} return

    set m [.mainframe getmenu privacy]
    if {$::ifacetk::options(show_tearoffs)} {
	set start 1
    } else {
	set start 0
    }
    for {set i $start} {$i <= [$m index end]} {incr i} {
	catch {$m entryconfigure $i -state normal}
    }
}

proc privacy::disable_menu {connid} {

    if {[first_supported] != ""} return

    set m [.mainframe getmenu privacy]
    if {$::ifacetk::options(show_tearoffs)} {
	set start 1
    } else {
	set start 0
    }
    for {set i $start} {$i <= [$m index end]} {incr i} {
	catch {$m entryconfigure $i -state disabled}
    }
    $m entryconfigure [$m index [::msgcat::mc "Activate lists at startup"]] \
       -state normal
}

hook::add connected_hook [namespace current]::privacy::enable_menu
hook::add disconnected_hook [namespace current]::privacy::disable_menu
hook::add finload_hook [list [namespace current]::privacy::disable_menu {}]

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

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