Skip to content

Instantly share code, notes, and snippets.

@vitalyster vitalyster/carbons.tcl
Last active Feb 15, 2018

Embed
What would you like to do?
XEP-0280: Carbons support for Tkabber
set ::NS(client) jabber:client
set ::NS(carbons) urn:xmpp:carbons:2
set ::NS(forwarded) urn:xmpp:forward:0
set ::NS(mucuser) http://jabber.org/protocol/muc#user
namespace eval carbons {
disco::register_feature $::NS(carbons)
hook::add rewrite_message_hook [namespace current]::extract_forwarded
hook::add connected_hook [namespace current]::enable
}
proc carbons::enable {xlib} {
::xmpp::sendIQ $xlib set -command [namespace current]::enable_callback \
-query [::xmpp::xml::create enable -xmlns $::NS(carbons)]
}
proc carbons::enable_callback {status xml} {
if {![string equal $status ok]} {
# log error
}
}
proc carbons::extract_forwarded {vxlib vfrom vid vtype vis_subject vsubject vbody verr vthread vpriority vx} {
upvar 2 $vxlib xlib
upvar 2 $vbody body
upvar 2 $verr err
upvar 2 $verr from
upvar 2 $vx x
if {$body ne ""} return
if {![::xmpp::jid::equal $from [::xmpp::jid::removeResource $from]]} return
foreach element $x {
::xmpp::xml::split $element tag xmlns attrs cdata childs
switch -- $tag {
sent -
received {
if {![string equal $xmlns $::NS(carbons)]} continue
foreach fel $childs {
xmpp::xml::split $fel ftag fxmlns fattrs fcdata fchilds
switch -- $ftag {
forwarded {
if {![string equal $fxmlns $::NS(forwarded)]} continue
foreach mel $fchilds {
xmpp::xml::split $mel mtag mxmlns mattrs mcdata mchilds
switch -- $mtag {
message {
if {![string equal $mxmlns $::NS(client)]} continue
if {[string equal $tag received]} {
foreach xel $mchilds {
xmpp::xml::split $xel xtag xxmlns xattrs xcdata xchilds
switch -- $xtag {
x {
set is_private [expr {[string equal $xxmlns $::NS(mucuser)] \
&& [string equal chat [::xmpp::xml::getAttr $mattrs type]]}]
if {$is_private} return
}
}
}
::xmpp::ParseMessage $xlib $mel
} else {
set chatid [chat::chatid $xlib [::xmpp::xml::getAttr $mattrs to]]
set mbody ""
foreach smchild $mchilds {
xmpp::xml::split $smchild stag sxmlns sattrs scdata ssubels
switch -- $stag {
body {set mbody $scdata}
default {lappend mx $smchild}
}
}
if {![string equal $mbody ""]} {
set from [::xmpp::xml::getAttr $mattrs from]
chat::add_message $chatid $from \
[::xmpp::xml::getAttr $mattrs type] $mbody [append mx ""]
}
}
}
}
}
}
}
}
}
}
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.