XEP-0280: Carbons support for Tkabber

carbons.tcl

    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 ""]
                                                }
                                            }
                        }
                    }
                    }
                }
                }
            }
            }
        }
        }
        
    }