@@ 2,6 2,10 @@
# - 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 {
@@ 21,6 25,7 @@ namespace eval ::cap {
foreach cap [split [string trim $list] " "] {
lappend ret $cap
}
+ return $ret
}
proc server_ls list {
regsub -all { +} $list { } list
@@ 32,7 37,7 @@ namespace eval ::cap {
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
+ dict set caps $capname true
}
{^(draft/languages|sasl)$} {
dict set caps $capname [split $value ","]
@@ 44,6 49,33 @@ namespace eval ::cap {
}
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} {
@@ 129,6 161,33 @@ namespace eval ::cap {
}
}
+ 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 handler dispatch {
variable logh
${logh}::debug "handling CAP message"
@@ 152,13 211,10 @@ namespace eval ::cap {
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; }
+ 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
- # 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 {}
@@ 171,17 227,28 @@ namespace eval ::cap {
}
if {[irc::meta get $chan cap status] == "sent"} {
- irc::meta set $chan cap status "ack-wait"
+ 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 {
- # 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!"
+ foreach cap [dict get $parsed caps] {
+ irc::meta unset $chan cap req-inflight $cap
+ irc::meta set $chan cap to-change $cap set
+ }
+ apply-caps $chan
}
NAK {
- # remove from cap.req-inflight
- puts "TODO!"
+ foreach cap [dict get $parsed caps] {
+ irc::meta unset $chan cap req-inflight $cap
+ }
+ apply-caps $chan
}
NEW {
# run cap.supporting handler, if applicable
@@ 201,20 268,20 @@ namespace eval ::cap {
}
}
- proc support {chan cap {script {expr {true}}}} {
+ 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]} {
- 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::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
}
- irc::meta set $chan cap supporting $cap $script
}
proc negotiate {chan} {
@@ 8,7 8,7 @@ source irc.tcl
source cap.tcl
puts "connecting to testnet.ergo.chat"
-set chan [irc::connect testnet.ergo.chat 6667 0]
+set chan [irc::connect testnet.ergo.chat 6697 1]
irc::handler add $chan * {
${log}::debug [dict get $dispatch rawmsg]