~aleteoryx/tclircc

tclircc/cap.tcl -rw-r--r-- 10.6 KiB
534b37f7Aleteoryx CAP fully implemented 20 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
# 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
  }
}