From cdcc9225b31a88fafa43e2a54c3a5d0021dbe3ea Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Fri, 20 Jun 2008 03:28:12 +0100 Subject: [PATCH] xep-0183: implemented receipt request responses in chat. Fixed caps in presence --- bin/bf_xmpp.tcl | 53 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 43 insertions(+), 10 deletions(-) diff --git a/bin/bf_xmpp.tcl b/bin/bf_xmpp.tcl index 4eea4f7..82b7233 100644 --- a/bin/bf_xmpp.tcl +++ b/bin/bf_xmpp.tcl @@ -76,15 +76,24 @@ proc ::xmppplugin::connect {callback args} { [namespace code [list OnPresenceChange $context]] # Discovery support - $xmpp(jlib) disco registeridentity client pc Bullfrog foreach feature {jabber:client jabber:iq:last jabber:iq:time \ - jabber:iq:version jabber:x:event} { + jabber:iq:version jabber:x:event urn:xmpp:receipts} { jlib::disco::registerfeature $feature } + $xmpp(jlib) disco registeridentity client pc Bullfrog - #$xmpp(jlib) caps register ? ? ? set [set xmpp(jlib)]::AppContext $context Callback $context init + + set e_color \ + [list [wrapper::createtag "identity" \ + -attrlist [list category hierarchy type leaf name "color"]]\ + [wrapper::createtag "feature" \ + -attrlist [list var "urn:tkchat:color"]]] + $xmpp(jlib) caps register color $e_color [list urn:tkchat:color] + #$xmpp(jlib) caps register time $e_time [list time urn:tkchat:color] + $xmpp(jlib) register_presence_stanza [get_caps $context] -type available + set xmpp(jid) [jlib::joinjid $xmpp(-username) $xmpp(-server) $xmpp(-resource)] $xmpp(jlib) connect init $xmpp(jlib) connect configure -defaultresource $xmpp(-resource) @@ -174,7 +183,7 @@ proc ::xmppplugin::post {ctx channel msg} { if {$thread eq ""} {set thread [uuid::uuid generate] } } - if {[catch {dict get $xmll(opts) $channel -chatstate} chatstate]} { + if {[catch {dict get $xmpp(opts) $channel -chatstate} chatstate]} { set chatstate active } @@ -219,12 +228,16 @@ proc ::xmppplugin::Version {ctx} { return $ver } +# Generates a jlib xmllist containing the xep-0115 caps data for this +# version of this application. Should be constant per instance. proc ::xmppplugin::get_caps {ctx} { + upvar #0 $ctx xmpp foreach {name ver os} [split [Version $ctx] :] break + set exts [$xmpp(jlib) caps getexts] ;# registered on startup set caps [wrapper::createtag c -attrlist \ [list xmlns "http://jabber.org/protocol/caps" \ - node "http://tkchat.tclers.tk/$name/caps" \ - ver $ver ext {color time}]] + node "http://tkchat.tcl.tk/$name/caps" \ + ver $ver ext $exts]] return $caps } @@ -274,7 +287,7 @@ proc ::xmppplugin::OnConnect {ctx jlib type args} { ok { Callback $ctx connect $jlib send_presence - $jlib send_presence -priority 2 -extras [list [get_caps $ctx]] + $jlib send_presence -priority 2 -show available $jlib roster send_get -command [list [namespace origin OnRosterGet] $ctx] if {$xmpp(-autoconnect) && $xmpp(-channel) ne {}} { Log $ctx "Attempting to join $xmpp(-channel)" @@ -617,6 +630,7 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} { [wrapper::getfirstchildwithtag $xmldata thread]]] set chatstate [wrapper::gettag \ [wrapper::getfirstchildwithxmlns $xmldata http://jabber.org/protocol/chatstates]] + set receipt [wrapper::getchildswithtagandxmlns $xmldata request urn:xmpp:receipts] foreach x [wrapper::getchildswithtag $xmldata x] { switch -exact -- [wrapper::getattribute $x xmlns] { @@ -695,6 +709,14 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} { } } # if chatstate stuff -- display somehow + + # xep-0183: receipt notification + if {[llength $receipt] > 0 && [info exists a(id)]} { + $xmpp(jlib) send_message $a(from) -id $a(id) -type $a(type) \ + -xlist [list [wrapper::createtag received \ + -attrlist {xmlns urn:xmpp:receipts}]] + } + if {[llength $body] > 0} { Callback $ctx chat $a(from) $nick \ [wrapper::getcdata [lindex $body 0]] normal @@ -715,8 +737,10 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} { } set p [list -date $time -subject $subject] if {$thread ne {}} {lappend p -thread $thread} - lappend p -body [wrapper::getcdata [lindex $body 0]] - eval [linsert $p 0 Callback $ctx message $a(to) $from] + lappend p -body [set bodydata [wrapper::getcdata [lindex $body 0]]] + if {[string length $body] > 0 || [string length $subject] > 0} { + eval [linsert $p 0 Callback $ctx message $a(to) $from] + } } headline { Callback $ctx chat $a(to) $a(from) \ @@ -739,7 +763,6 @@ proc ::xmppplugin::OnMessage2 {ctx jlib xmldata} { } } - proc ::xmppplugin::query_user {Chat user what} { upvar #0 $Chat ctx upvar #0 $ctx(xmpp) xmpp @@ -765,6 +788,16 @@ proc ::xmppplugin::query_user {Chat user what} { return } +proc ::xmppplugin::SendReceipt {Chat} { + lappend xlist [wrapper::createtag received \ + -attrlist {xmlns urn:xmpp:receipts}] + set margs [list -type $chat(type) -xlist $xlist] + if {![catch {set thread [dict get $xmpp(opts) $chat(channel) -thread]}]} { + lappend margs -thread $thread + } + eval [linsert $margs 0 $xmpp(jlib) send_message $chat(channel)] +} + package provide xmppplugin $::xmppplugin::version # ------------------------------------------------------------------------- -- 2.23.0