# 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)
# 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
}
}
proc server_ls list {
regsub -all { +} $list { } list
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 available
}
{^(draft/languages|sasl)$} {
dict set caps $capname [split $value ","]
}
default {
dict set caps $capname $value
}
}
}
return $caps
}
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_ls [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 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: $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] && [irc::meta exists $chan cap supporting $cap]} {
# if we don't really support it, continue
uplevel #0 [list set capvalue $val]
if ![uplevel #0 [irc::meta get $chan cap supporting $cap]] { continue; }
# this little manouver pushes to the req-inflight stack
irc::meta set $chan cap req-inflight [concat [irc::meta get $chan cap req-inflight] [list $cap]]
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"} {
irc::meta set $chan cap status "ack-wait"
}
}
}
ACK {
# move [0-9a-z\-]+ from cap.req-inflight to cap.enabled; remove -[0-9a-z\-]+ from both cap.req-inflight and cap.enabled
puts "TODO!"
}
NAK {
# remove from cap.req-inflight
puts "TODO!"
}
NEW {
# run cap.supporting handler, if applicable
puts "TODO!"
}
DEL {
# remove from cap.req-inflight, possibly add support for cleanup code
puts "TODO!"
}
LIST {
# replace cap.available, remove any nonexistent cap.enabled entries, rerun the loop from CAP LS handling
puts "TODO!"
}
default {
puts "TODO!"
}
}
}
proc support {chan cap {script {expr {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]} {
uplevel #0 [list set capvalue [irc::meta get $chan cap available $cap]]
if [uplevel #0 $script] {
# this little manouver pushes to the req-inflight stack
irc::meta set $chan cap req-inflight [concat [irc::meta get $chan cap req-inflight] [list $cap]]
irc::msg send $chan CAP REQ $cap
}
}
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 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
}
}