3 files changed, 97 insertions(+), 66 deletions(-)

M cap.tcl
M irc.tcl
M main.tcl

@@ 29,6 29,7 @@ namespace eval ::cap {
   }
   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


@@ 123,7 124,7 @@ namespace eval ::cap {
         }
 
         dict set ret success true
-        dict set ret caps [server_ls [lindex $cmdargs 0]]
+        dict set ret caps [server_nack [lindex $cmdargs 0]]
 
         return $ret
       }


@@ 188,6 189,13 @@ namespace eval ::cap {
     }
   }
 
+  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"


@@ 196,7 204,7 @@ namespace eval ::cap {
 
     set parsed [parse_msg [dict get $dispatch params]]
 
-    if ![dict get $parsed success] { ${logh}::error "got bad CAP message: $rawmsg"; return }
+    if ![dict get $parsed success] { ${logh}::error "got bad CAP message: [dict get $dispatch rawmsg]"; return }
 
     switch -- [dict get $parsed type] {
       LS {


@@ 238,7 246,9 @@ namespace eval ::cap {
         }
       }
       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
         }


@@ 246,24 256,32 @@ namespace eval ::cap {
       }
       NAK {
         foreach cap [dict get $parsed caps] {
+          ${logh}::warn "CAP NAK: $cap"
           irc::meta unset $chan cap req-inflight $cap
         }
         apply-caps $chan
       }
       NEW {
-        # run cap.supporting handler, if applicable
-        puts "TODO!"
+        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 {
-        # remove from cap.req-inflight, possibly add support for cleanup code
-        puts "TODO!"
+        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 {
-        # replace cap.available, remove any nonexistent cap.enabled entries, rerun the loop from CAP LS handling
-        puts "TODO!"
-      }
-      default {
-        puts "TODO!"
+        irc::meta set $chan cap enabled {}
+        foreach cap [dict get $parsed caps] {
+          irc::meta set $chan cap enabled $cap set
+        }
       }
     }
   }


@@ 289,6 307,7 @@ namespace eval ::cap {
 
     ${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"

@@ 19,11 19,14 @@
 package require Thread
 
 namespace eval ::irc {
+  variable log [logger::init tclircc::irc]
+  variable logd [logger::init tclircc::irc::dispatch]
+  variable logp [logger::init tclircc::irc::proto]
   variable chan.meta
   variable chan.handlers
 
   # documented
-  proc ::irc::is {type value {cap {}}} {
+  proc is {type value {cap {}}} {
     # validation helper.
     # cap is a list of negotiated capabilities.
     switch -- $type {


@@ 53,7 56,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::esc {type value} {
+  proc esc {type value} {
     # for escaping specific things
     switch -- $type {
       tags::value {


@@ 69,7 72,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::unesc {type value} {
+  proc unesc {type value} {
     # for unescaping specific things
     # needs to be handled manually due to Quirkiness
     switch -- $type {


@@ 105,7 108,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::connect {hostname port {usetls 0}} {
+  proc connect {hostname port {usetls 0}} {
     if $usetls {
       if {[info commands ::tls::socket] == ""} { package require tls }
       set chan [::tls::socket $hostname $port]


@@ 124,7 127,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::enroll {chan {meta {}}} {
+  proc enroll {chan {meta {}}} {
     variable chan.meta
     variable chan.handlers
     fconfigure $chan -translation crlf -blocking 0


@@ 133,7 136,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::listen {subcommand chan} {
+  proc listen {subcommand chan} {
     switch -- $subcommand {
       on {
         fileevent $chan readable [list ::irc::int-onmsg $chan]


@@ 149,7 152,7 @@ namespace eval ::irc {
   }
 
   # nodoc
-  proc ::irc::int-dictsub args {
+  proc int-dictsub args {
     if [catch { uplevel [list dict {*}$args] } result options] {
       return -options $options [regsub {dictionary$} $result "channel meta"]
     } else {


@@ 158,26 161,26 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::meta {subcommand chan args} {
+  proc meta {subcommand chan args} {
     variable chan.meta
     switch -- $subcommand {
       exists {
         if ![llength $args] { return -code error "wrong # args: should be \"irc::meta exists chan key ?key ...?\"" }
 
-        ::irc::int-dictsub exists [set chan.meta($chan)] {*}$args
+        int-dictsub exists [set chan.meta($chan)] {*}$args
       }
       unset {
         if ![llength $args] { return -code error "wrong # args: should be \"irc::meta unset chan key ?key ...?\"" }
 
-        ::irc::int-dictsub unset chan.meta($chan) {*}$args
+        int-dictsub unset chan.meta($chan) {*}$args
       }
       get {
-        ::irc::int-dictsub get [set chan.meta($chan)] {*}$args
+        int-dictsub get [set chan.meta($chan)] {*}$args
       }
       set {
         if {[llength $args] < 2} { return -code error "wrong # args: should be \"irc::meta set chan key ?key ...? value\"" }
 
-        ::irc::int-dictsub set chan.meta($chan) {*}$args
+        int-dictsub set chan.meta($chan) {*}$args
       }
       read {
         if [llength $args] { return -code error "wrong # args: should be \"irc::meta read chan\"" }


@@ 189,7 192,7 @@ namespace eval ::irc {
   }
 
   # nodoc
-  proc ::irc::int-setaliases {interp} {
+  proc int-setaliases {interp} {
     $interp alias irc::is irc::is
     $interp alias irc::msg irc::msg
     $interp alias irc::listener irc::listener


@@ 204,10 207,11 @@ namespace eval ::irc {
   }
 
   # nodoc
-  proc ::irc::int-onmsg {chan} {
+  proc int-onmsg {chan} {
     set msg [gets $chan]
     if {$msg == ""} { return }
 
+    variable logd
     variable chan.meta
     variable chan.handlers
 


@@ 249,38 253,45 @@ namespace eval ::irc {
       if !$matched { continue }
 
       set matchedany true
-      switch -- $type {
-        chan {
-          lassign $rest writer interp
-          puts $writer $dispatch
-          flush $writer
-        }
-        tchan {
-          lassign $rest writer thread
-          puts $writer $dispatch
-          flush $writer
-        }
-        extern {
-          lassign $rest ochan ichan
-          puts $ochan $chan
-          puts $ochan $msg
-          flush $ochan
-        }
-        script {
-          set interp [lassign $rest script]
-          if [llength $interp] {
-            set interp [lindex $interp 0]
-            {*}$interp eval [list set dispatch $dispatch]
-            {*}$interp eval $script
-          } else {
-            uplevel #0 [list set dispatch $dispatch]
-            uplevel #0 $script
+      if [set code [catch {
+        switch -- $type {
+          chan {
+            lassign $rest writer interp
+            puts $writer $dispatch
+            flush $writer
+          }
+          tchan {
+            lassign $rest writer thread
+            puts $writer $dispatch
+            flush $writer
+          }
+          extern {
+            lassign $rest ochan ichan
+            puts $ochan $chan
+            puts $ochan $msg
+            flush $ochan
+          }
+          script {
+            set interp [lassign $rest script]
+            if [llength $interp] {
+              set interp [lindex $interp 0]
+              {*}$interp eval [list set dispatch $dispatch]
+              {*}$interp eval $script
+            } else {
+              uplevel #0 [list set dispatch $dispatch]
+              uplevel #0 $script
+            }
+          }
+          tscript {
+            lassign $rest script thread
+            thread::send -async $thread [list set dispatch $dispatch]
+            thread::send -async $thread $script
           }
         }
-        tscript {
-          lassign $rest script thread
-          thread::send -async $thread [list set dispatch $dispatch]
-          thread::send -async $thread $script
+      } result options]] {
+        if {$code == 1} {
+          ${logd}::error "error in $type handler $id (pattern list: [list $patlist]): $result"
+          ${logd}::error "errorInfo: [dict get $options -errorinfo]"
         }
       }
     }


@@ 290,11 301,11 @@ namespace eval ::irc {
   }
 
   # nodoc
-  proc ::irc::int-rminterp {interp} {
+  proc int-rminterp {interp} {
     interp delete $interp
   }
   # documented
-  proc ::irc::listener {subcommand chan args} {
+  proc listener {subcommand chan args} {
     variable chan.handlers
     switch -- $subcommand {
       add {


@@ 358,7 369,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::handler {subcommand chan args} {
+  proc handler {subcommand chan args} {
     variable chan.handlers
     switch -- $subcommand {
       add {


@@ 414,14 425,14 @@ namespace eval ::irc {
   }
 
   # nodoc
-  proc ::irc::int-onextern {ichan chan} {
+  proc int-onextern {ichan chan} {
     set msg [gets $ichan]
     if {$msg == ""} return
     puts $chan $msg
     flush $chan
   }
   # documented
-  proc ::irc::extern {subcommand chan args} {
+  proc extern {subcommand chan args} {
     variable chan.handlers
     switch -- $subcommand {
       add {


@@ 455,7 466,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::patlist {chan id {patlist {}}} {
+  proc patlist {chan id {patlist {}}} {
     if {$patlist != ""} {
       set newlist ""
       foreach handler [dict get chanmeta($chan) handlers] {


@@ 477,7 488,7 @@ namespace eval ::irc {
 
 
   # documented
-  proc ::irc::src {subcommand args} {
+  proc src {subcommand args} {
     switch -- $subcommand {
       parse {
         if {[llength $args] ni {1 2}} { return -code error "wrong # args: should be \"irc::src parse src ?partsVar?\"" }


@@ 533,7 544,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::tags {subcommand args} {
+  proc tags {subcommand args} {
     switch -- $subcommand {
       exists {
         if {[llength $args] != 2} { return -code error "wrong # args: should be \"irc::tags exists tags key\"" }


@@ 658,7 669,7 @@ namespace eval ::irc {
   }
 
   # documented
-  proc ::irc::msg {subcommand args} {
+  proc msg {subcommand args} {
     switch -- $subcommand {
       fmt {
         if ![llength $args] { return -code error "wrong # args: should be \"irc::msg fmt ?-tags tags? ?-src src? cmd ?arg ...? \"" }

@@ 7,8 7,9 @@ set log [logger::init tclircc]
 source irc.tcl
 source cap.tcl
 
-puts "connecting to testnet.ergo.chat"
-set chan [irc::connect testnet.ergo.chat 6697 1]
+#puts "connecting to testnet.ergo.chat"
+#set chan [irc::connect testnet.ergo.chat 6697 1]
+set chan [irc::connect localhost 8000 0]
 
 irc::handler add $chan * {
   ${log}::debug [dict get $dispatch rawmsg]