# cap.status:
# - sent (we have sent CAP LS 302, no terminal reply)
# - ack-wait (we've sent off the first REQ, wait for an ACK to update state and send END. will only transition when cap.req-inflight == {})
# - finished (all other CAP negotiation(CAP NEW) is handled asynchronously)
# cap.available: dict of CAPs advertised to us
# cap.req-inflight: set of inflight CAP REQs. aka a dict where the value is ignored
# cap.supporting: dict of cap -> callback pairs
# handling for CAP-related things
namespace eval ::cap {
variable log [logger::init tclircc::cap]
variable logp [logger::init tclircc::cap::parser]
variable logh [logger::init tclircc::cap::dispatch]
proc value_dict str {
set ret {}
foreach pair [split $str ","] {
set value [join [lassign [split $pair "="] key] "="]
dict set ret $key $value
}
return $ret
}
proc server_nack list {
regsub -all { +} $list { } list
foreach cap [split [string trim $list] " "] {
lappend ret $cap
}
return $ret
}
proc server_ls list {
regsub -all { +} $list { } list
set caps {}
foreach cap [split [string trim $list] " "] {
set value [join [lassign [split $cap "="] capname] "="]
# auto-parse registry capabilities
switch -regexp -- $capname {
{^(draft/account-registration|draft/metadata-2|draft/multiline|sts)$} {
dict set caps $capname [value_dict $value]
}
{^(account-notify|account-tag|away-notify|batch|cap-notify|draft/channel-rename|draft/chathistory|chghost|echo-message|draft/event-playback|extended-join|extended-monitor|invite-notify|labeled-response|draft/message-redaction|message-tags|draft/metadata-notify-2|multi-prefix|draft/no-implicit-names|draft/pre-away|draft/read-marker|server-time|setname|standard-replies|userhost-in-names)$} {
dict set caps $capname true
}
{^(draft/languages|sasl)$} {
dict set caps $capname [split $value ","]
}
default {
dict set caps $capname $value
}
}
}
return $caps
}
proc implied_caps caps {
set ret {}
set retd {}
foreach cap $caps {
switch -- $cap {
draft/account-registration {
lappend ret standard-replies
}
account-tag {
lappend ret message-tags
}
batch {
lappend ret message-tags
}
draft/chathistory {
lappend ret batch server-time message-tags
}
}
}
foreach cap $ret {
dict set retd $cap set
}
return $retd
}
proc parse_msg cmdargs {
variable logp
if {[llength $cmdargs] <= 2} {
${logp}::error "misbehaving server: sent [llength $cmdargs] args for CAP command: $cmdargs"
return {success false}
}
set cmdargs [lassign $cmdargs target cmd]
switch -- $cmd {
LS {
dict set ret type LS
if {[llength $cmdargs] ni {1 2}} {
${logp}::error "misbehaving server: sent [expr {[llength $cmdargs]+2}] args for CAP LS command: $cmdargs"
return {success false}
}
dict set ret success true
if {[llength $cmdargs] == 2} {
if {[lindex $cmdargs 0] != "*"} { ${logp}::warn "misbehaving server: sent [lindex $cmdargs 0] instead of * in CAP LS" }
dict set ret multiline true
dict set ret caps [server_ls [lindex $cmdargs 1]]
} else {
dict set ret multiline false
dict set ret caps [server_ls [lindex $cmdargs 0]]
}
return $ret
}
NEW {
dict set ret type NEW
if {[llength $cmdargs] != 1} {
${logp}::error "misbehaving server: sent [expr {[llength $cmdargs]+2}] args for CAP LS command: $cmdargs"
return {success false}
}
dict set ret success true
dict set ret caps [server_ls [lindex $cmdargs 0]]
return $ret
}
DEL {
dict set ret type NEW
if {[llength $cmdargs] != 1} {
${logp}::error "misbehaving server: sent [expr {[llength $cmdargs]+2}] args for CAP LS command: $cmdargs"
return {success false}
}
dict set ret success true
dict set ret caps [server_nack [lindex $cmdargs 0]]
return $ret
}
ACK {
dict set ret type ACK
if {[llength $cmdargs] != 1} {
${logp}::error "misbehaving server: sent [expr {[llength $cmdargs]+2}] args for CAP ACK command: $cmdargs"
return {success false}
}
dict set ret success true
dict set ret caps [server_nack [lindex $cmdargs 0]]
}
NAK {
dict set ret type NAK
if {[llength $cmdargs] != 1} {
${logp}::error "misbehaving server: sent [expr {[llength $cmdargs]+2}] args for CAP NAK command: $cmdargs"
return {success false}
}
dict set ret success true
dict set ret caps [server_nack [lindex $cmdargs 0]]
}
LIST {
dict set ret type LIST
if {[llength $cmdargs] != 1} {
${logp}::error "misbehaving server: sent [expr {[llength $cmdargs]+2}] args for CAP LIST command: $cmdargs"
return {success false}
}
dict set ret success true
dict set ret caps [server_nack [lindex $cmdargs 0]]
}
default {
${logp}::error "misbehaving server: sent CAP $cmd message"
return {success false}
}
}
}
proc test-cap {chan capname capval} {
if [irc::meta exists $chan cap supporting $capname] {
uplevel #0 [list apply [list {capname capval} [irc::meta get $chan cap supporting $capname]] $capname $capval]
} else {
return false
}
}
proc apply-caps chan {
variable logh
if [llength [irc::meta get $chan cap req-inflight]] return
foreach cap [dict keys [irc::meta get $chan cap to-change]] {
if {[string range $cap 0 0] == "-"} {
irc::meta unset $chan cap enabled $cap
} else {
irc::meta set $chan cap enabled $cap set
}
}
irc::meta set $chan cap implied [implied_caps [dict keys [irc::meta get $chan cap enabled]]]
irc::meta set $chan cap to-change {}
if {[irc::meta get $chan cap status] == "ack-wait"} {
irc::msg send $chan CAP END
${logh}::info "initial capability negotiation complete"
irc::meta set $chan cap status "finished"
}
}
proc req-cap {chan cap} {
variable log
${log}::debug "attempting to negotiate $cap"
irc::meta set $chan cap req-inflight $cap set
irc::msg send $chan CAP REQ $cap
}
proc handler dispatch {
variable logh
${logh}::debug "handling CAP message"
set chan [dict get $dispatch chan]
set parsed [parse_msg [dict get $dispatch params]]
if ![dict get $parsed success] { ${logh}::error "got bad CAP message: [dict get $dispatch rawmsg]"; return }
switch -- [dict get $parsed type] {
LS {
if [dict get $parsed multiline] {
${logh}::debug "accumulating multiline CAP LS"
irc::meta set $chan cap ls-buffer [dict merge [irc::meta get $chan cap ls-buffer] [dict get $parsed caps]]
} else {
set available [dict merge [irc::meta get $chan cap ls-buffer] [dict get $parsed caps]]
irc::meta set $chan cap available $available
irc::meta set $chan cap ls-buffer {}
set req_acc {}
dict for {cap val} $available {
# if we don't have a capability enabled, and we support it, request it
if {![irc::meta exists $chan cap enabled $cap] && [test-cap $chan $cap $val]} {
${logh}::debug "attempting to negotiate $cap"
irc::meta set $chan cap req-inflight $cap set
if {[string length [concat $req_acc [list $cap]]] >= 500} {
irc::msg send $chan CAP REQ $req_acc
set $req_acc {}
}
lappend req_acc $cap
}
}
if [string length $req_acc] {
irc::msg send $chan CAP REQ $req_acc
}
if {[irc::meta get $chan cap status] == "sent"} {
if [llength [irc::meta get $chan cap req-inflight]] {
irc::meta set $chan cap status "ack-wait"
} else {
irc::meta set $chan cap status "finished"
irc::msg send $chan CAP END
${logh}::info "initial capability negotiation ended early: no capabilities to negotiate"
}
}
}
}
ACK {
# TODO: hook for ACKed CAPs
foreach cap [dict get $parsed caps] {
${logh}::info "CAP ACK: $cap"
irc::meta unset $chan cap req-inflight $cap
irc::meta set $chan cap to-change $cap set
}
apply-caps $chan
}
NAK {
foreach cap [dict get $parsed caps] {
${logh}::warn "CAP NAK: $cap"
irc::meta unset $chan cap req-inflight $cap
}
apply-caps $chan
}
NEW {
dict for {cap val} [dict get $parsed caps] {
# TODO: interface to check when CAPs change parameters and toggle them
irc::meta set $chan cap available $cap $val
if {![irc::meta exists $chan cap enabled $cap] && [test-cap $chan $cap $val]} {
req-cap $chan $cap
}
}
}
DEL {
foreach cap [dict get $parsed caps] {
# TODO: cleanup hook for disabled CAPs
irc::meta unset $chan cap available $cap
irc::meta unset $chan cap enabled $cap
}
}
LIST {
irc::meta set $chan cap enabled {}
foreach cap [dict get $parsed caps] {
irc::meta set $chan cap enabled $cap set
}
}
}
}
proc support {chan cap {script {return true}}} {
variable log
${log}::info "supporting CAP $cap"
# if we're not in early boot, and haven't already requested the capability, request it
if {[irc::meta exists $chan cap status] && [irc::meta get $chan cap status] != "sent" && [irc::meta exists $chan cap available $cap] && ![irc::meta exists $chan cap supporting $cap]} {
irc::meta set $chan cap supporting $cap $script
if [test-cap $chan $cap [irc::meta get $chan cap available $cap]] {
irc::meta set $chan cap req-inflight $cap set
irc::msg send $chan CAP REQ $cap
}
} else {
irc::meta set $chan cap supporting $cap $script
}
}
proc negotiate {chan} {
variable log
${log}::info "attempting capability negotiation for $chan ([irc::meta get $chan uri])"
irc::meta set $chan cap ls-buffer {}
irc::meta set $chan cap to-change {}
irc::meta set $chan cap req-inflight {}
irc::meta set $chan cap handler [irc::handler add $chan CAP { cap::handler $dispatch }]
irc::meta set $chan cap status "sent"
irc::msg send $chan CAP LS 302
}
}