From 826d12106c72296b8b4840e505a9b4155b44ac56 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Tue, 24 Mar 2026 00:50:56 +0100 Subject: [PATCH] Add some IRCv3 features * capability negotiation, some default requests * tags on messages, like server time, message id, user account * explicit batches such as multiline, chathistory or event-playback * echo-message so we get msgids for our own outgoing messages --- lib/IRC/Client.rakumod | 220 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 208 insertions(+), 12 deletions(-) diff --git a/lib/IRC/Client.rakumod b/lib/IRC/Client.rakumod index e33509f..041632b 100644 --- a/lib/IRC/Client.rakumod +++ b/lib/IRC/Client.rakumod @@ -31,6 +31,12 @@ class Server:ver<4.0.15>:auth { has Int $!last-ping; has Int $!ping-wait; + #| Active capabilities + has Str @.capabilities; + + #| Capabilities advertised by the server + has Str @.available-capabilities; + method label() { $!label eq '_' ?? "$!host:$!port" !! $!label } @@ -93,6 +99,11 @@ role Message::Numeric does Message { } role Message::Part does Message { has $.channel } role Message::Quit does Message { } +role Message::Batch does Message { has $.reference-tag; has $.batch-type; has @.batch-messages; } +role Message::Batch::End does Message { has $.reference-tag; } + +role Message::Capabilities does Message { } + role Message::Ping does Message { method reply() { $.server.set-ping-wait; @@ -175,6 +186,7 @@ role Message { has Str $.command is required; has Server $.server is required; has $.args is required; + has %.msg-tags; method Str { ":$!usermask $!command $!args[]" } } @@ -187,7 +199,23 @@ grammar Grammar { token TOP { + } token left-overs { \N* } token SPACE { ' '+ } - token message { [':' ]? \n } + token message { ['@' ]? [':' ]? \n } + + regex msg-tags { + + % ';' + } + token tag { + [ '=' ]? + } + regex tag-key { + $='+'? [ '/' ]? + } + token tag-key-name { + <[a..z A..Z 0..9 -]>+ + } + token tag-value { + <-[\0 \n \r ; \ ]>* + } regex prefix { [ || ['!' ]? ['@' ]? ] @@ -201,7 +229,7 @@ grammar Grammar { [ | | ]+ } token user { <-[\ \x[0]\r\n]>+? | '@']>} - token host { <-[\s!@]>+ } + token host { <-[\s ! @ / =]>+ } token command { + | **3 } @@ -228,9 +256,29 @@ class Actions:ver<4.0.15>:auth { ); } + # IRCv3 message tags + # parsed whether message-tags capability was negotiated or not + method tag($/) { + my $val = ""; + with $ { + # TODO: backslashes with no valid escapee should disappear, + # as should backslashes at the end before the semicolon. + $val = ~$.trans(['\:', '\s', '\r', '\n', '\\'] => [";", ' ', "\r", "\n", "\\"]); + } + $/.make: ~$ => $val; + } + method message($match) { my %args; + my %msg-tags; + with $match { + for $match.list { + # Follows spec to only use the latest occurrence of a tag for its value + %msg-tags{.made.key} = .made.value; + } + } + my %who; %who := .hash with %args; with $match { my %pref := .hash; @@ -261,7 +309,8 @@ class Actions:ver<4.0.15>:auth { nick => %who // '', server => $!server, usermask => ($match // '').Str, - username => %who // ''; + username => %who // '', + msg-tags => %msg-tags; my @params := %args; $match.make: do given %msg-args { @@ -296,7 +345,7 @@ class Actions:ver<4.0.15>:auth { !! IRC::Client::Message::Notice::Me.new( :text(@params[1]), |%msg-args) } - when 'MODE' { + when 'MODE' { my $channel := @params[0]; my $mode := @params[1]; $channel.starts-with('#') || $channel.starts-with('&') @@ -309,11 +358,32 @@ class Actions:ver<4.0.15>:auth { IRC::Client::Message::Topic.new( :channel(@params[0]), :text(@params[1]), |%msg-args) } + when 'BATCH' { + if @params[0].starts-with("+") { + IRC::Client::Message::Batch.new( + :batch-type(@params[1]), + :reference-tag(@params[0].substr(1)), + |%msg-args + ); + } + elsif @params[0].starts-with("-") { + IRC::Client::Message::Batch::End.new( + :reference-tag(@params[0].substr(1)), + |%msg-args + ); + } + else { + Irc::Client::Message::Unknown.new(|%msg-args); + } + } when 'QUIT' { IRC::Client::Message::Quit.new(|%msg-args) } + when 'CAP' { + IRC::Client::Message::Capabilities.new(|%msg-args); + } default { - .chars == 3 && try 0 <= .Int <= 999 + .chars == 3 && (try 0 <= .Int <= 999) ?? IRC::Client::Message::Numeric.new(|%msg-args) !! IRC::Client::Message::Unknown.new(|%msg-args) } @@ -499,9 +569,74 @@ method send(:$where!, :$text!, :$server, :$notice --> IRC::Client:D) { self } +# TODO: support other variants than just "LATEST" with limit number. +method chathistory(:$target!, :$limit = 50, :$server!) { + if self!get-server($server).is-connected { + self.send-cmd: 'CHATHISTORY', 'LATEST', $target, '*', $limit, + :server($server); + } + else { + die ".chathistory() called for an unconnected server."; + } +} + #------------------------------------------------------------------------------- # Private Methods +# Support for the IRCv3 "batch" capability +method !make-batch-filter($server, Supply $events) { + supply { + my %batches; + + whenever $events { + when IRC::Client::Message::Batch { + if %batches{$_.reference-tag}:exists { + # TODO: decide how to deal with erroneous batch commands + debug "Batch with reference tag $_.reference-tag() already started?!", :$server, :in; + } + else { + %batches{$_.reference-tag} = $_; + with $_.msg-tags -> $batch-tag { + with %batches{$batch-tag} -> $outer-batch { + $outer-batch.batch-messages.push: $_; + } else { + debug "Batch with reference tag $_.reference-tag() refers to outer batch $batch-tag that doesn't exist?!", :$server, :in; + } + } + } + } + when IRC::Client::Message::Batch::End { + with %batches{$_.reference-tag}:delete -> $batch { + $batch.batch-messages.push: $_; + # If this batch doesn't have an outer batch, emit it + without $batch.msg-tags { + emit $batch; + } + # "inner" batches get emitted as part of the batch they're contained in. + } + else { + debug "Batch end event with reference tag $_.reference-tag() refers to batch doesn't exist?!", :$server, :in; + } + } + when Message { + with $_.msg-tags -> $batch-tag { + with %batches{$batch-tag} -> $batch { + $batch.batch-messages.push: $_; + } else { + debug "Message refering to batch $batch-tag that doesn't exist!?", :$server, :in; + } + } + else -> $ { + emit $_; + } + } + default { + emit $_; + } + } + } +} + method !change-nick($server --> Nil) { my int $idx = 0; for $server.nick.kv -> int $i, $nick { @@ -537,14 +672,17 @@ method !connect-socket($server --> Nil) { if $prom.status ~~ Broken { $server.is-connected = False; debug "Could not connect: $prom.cause()", :out, :$server; - sleep 10; - $!socket-pipe.send: $server; + Promise.in(10).then({ + $!socket-pipe.send: $server; + }); return; } $server.socket = $prom.result; $server.cue-next-ping-check(default-ping-wait); + self!ssay: "CAP LS 302", :$server, :dont-cue; + self!ssay: "PASS $server.password()", :$server, :dont-cue if $server.password.defined; self!ssay: "NICK {$server.nick[0]}", :$server, :dont-cue; @@ -553,23 +691,29 @@ method !connect-socket($server --> Nil) { $server.username, $server.host, ':' ~ $server.userreal; my $left-overs = ''; - react { + my $events = supply { whenever $server.socket.Supply :bin -> $buf is copy { my $str = try $buf.decode: 'utf8'; $str or $str = $buf.decode: 'latin-1'; $str = $left-overs ~ $str if $left-overs; (my $events, $left-overs) = self!parse: $str, :$server; - $!event-pipe.send: $_ for $events.grep: *.defined; + emit $_ for $events.grep: *.defined; CATCH { default { warn $_; warn .backtrace; done } } } } + my $batched-events = self!make-batch-filter($server, $events); + + react whenever $batched-events -> $event { + $!event-pipe.send($event); + } + unless $server.has-quit { $server.is-connected = False; debug "Connection closed", :in, :$server; - sleep 1; + await Promise.in(1); } $!socket-pipe.send: $server; @@ -578,8 +722,56 @@ method !connect-socket($server --> Nil) { } else { debug "Connection to $server.alias() failed: $!", :sys, :$server; - sleep 10; - $!socket-pipe.send: $server; + Promise.in(10).then({ + $!socket-pipe.send: $server; + }) + } +} + +# IRCv3 capability negotiation. +# method !connect-socket initiates with `CAP LS 302` which is kind of the +# version of the capability negotiation spec that we implement. +# Specs: https://ircv3.net/specs/extensions/capability-negotiation.html +# Values are currently handled as if they were part of the capability name. +method !capability-negotiation($e) { + my $server = $e.server; + + my @args = $e.args.list; + my $mynick = @args.shift; + + # TODO: handle capabilities with values in them + + if @args[0] eq 'LS' { + my @caps = @args.tail.split(" "); + $server.available-capabilities.push($_) for (@caps (-) $server.available-capabilities).keys; + debug "capabilities are now " ~ $server.available-capabilities.join(", "), :$server, :sys; + if @args[1] eq '*' { + # expect more lines + } + else { + debug "received all capabilities from server", :$server, :sys; + my @to-request = ( (&) $server.available-capabilities.map(*.split("=").head)).keys; + self!ssay: "CAP REQ :" ~ @to-request.join(" "), :$server, :dont-cue; + self!ssay: "CAP END", :$server, :dont-cue; + } + } + elsif @args[0] eq 'ACK' | 'NEW' { + my @to-add = @args.tail.split(" "); + debug "capability $e.args.tail() " ~ (@args[0] eq "ACK" ?? "acknowledged" !! "announced"), :$server, :sys; + $server.capabilities = ($server.capabilities (|) @to-add).keys; + } + elsif @args[0] eq 'DEL' { + # Oh no! + # anyway ... + my @to-remove = @args.tail.split(" "); + debug "capabilities removed by the server: @to-remove[]", :$server, :in; + $server.capabilities = ($server.capabilities (-) @to-remove).keys; + } + elsif @args[0] eq 'NAK' { + # oh crap! + # how did this happen? + my @not-added = @args.tail.split(" "); + debug "capabilities nak-ed by the server! @not-added[]", :$server, :in; } } @@ -592,6 +784,10 @@ method !handle-event($e) { } when 'PING' { return $e.reply; } when '433'|'432' { self!change-nick: $s; } + + # React to capability messages with our own logic first, + # but plugins get to see them, too. + when 'CAP' { self!capability-negotiation: $e } } my $event-name = 'irc-'