Skip to content

Add some IRCv3 features #71

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
timo wants to merge 1 commit into
base: main
Choose a base branch
from
Draft

Add some IRCv3 features #71

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
220 changes: 208 additions & 12 deletions lib/IRC/Client.rakumod
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,12 @@ class Server:ver<4.0.15>:auth<zef:lizmat> {
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
}
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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[]" }
}
Expand All @@ -187,7 +199,23 @@ grammar Grammar {
token TOP { <message>+ <left-overs> }
token left-overs { \N* }
token SPACE { ' '+ }
token message { [':' <prefix> <SPACE> ]? <command> <params> \n }
token message { ['@' <msg-tags> <SPACE>]? [':' <prefix> <SPACE> ]? <command> <params> \n }

regex msg-tags {
<tag>+ % ';'
}
token tag {
<tag-key> [ '=' <tag-value> ]?
}
regex tag-key {
$<client-only>='+'? [ <vendor=.host> '/' ]? <tag-key-name>
}
token tag-key-name {
<[a..z A..Z 0..9 -]>+
}
token tag-value {
<-[\0 \n \r ; \ ]>*
}

regex prefix {
[ <servername> || <nick> ['!' <user>]? ['@' <host>]? ]
Expand All @@ -201,7 +229,7 @@ grammar Grammar {
[ <letter> | <number> | <special> ]+
}
token user { <-[\ \x[0]\r\n]>+? <before [<SPACE> | '@']>}
token host { <-[\s!@]>+ }
token host { <-[\s ! @ / =]>+ }

token command { <letter>+ | <number>**3 }

Expand All @@ -228,9 +256,29 @@ class Actions:ver<4.0.15>:auth<zef:lizmat> {
);
}

# IRCv3 message tags
# parsed whether message-tags capability was negotiated or not
method tag($/) {
my $val = "";
with $<tag-value> {
# TODO: backslashes with no valid escapee should disappear,
# as should backslashes at the end before the semicolon.
$val = ~$<tag-value>.trans(['\:', '\s', '\r', '\n', '\\'] => [";", ' ', "\r", "\n", "\\"]);
}
$/.make: ~$<tag-key> => $val;
}

method message($match) {
my %args;

my %msg-tags;
with $match<msg-tags> {
for $match<msg-tags><tag>.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<who>;
with $match<prefix> {
my %pref := .hash;
Expand Down Expand Up @@ -261,7 +309,8 @@ class Actions:ver<4.0.15>:auth<zef:lizmat> {
nick => %who<nick> // '',
server => $!server,
usermask => ($match<prefix> // '').Str,
username => %who<user> // '';
username => %who<user> // '',
msg-tags => %msg-tags;

my @params := %args<params>;
$match.make: do given %msg-args<command> {
Expand Down Expand Up @@ -296,7 +345,7 @@ class Actions:ver<4.0.15>:auth<zef:lizmat> {
!! 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('&')
Expand All @@ -309,11 +358,32 @@ class Actions:ver<4.0.15>:auth<zef:lizmat> {
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)
}
Expand Down Expand Up @@ -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> -> $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<batch> {
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> -> $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 {
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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 = (<batch account-tag account-notify echo-message extended-join invite-notify message-tags server-time draft/multiline draft/chathistory draft/event-playback> (&) $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;
}
}

Expand All @@ -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-'
Expand Down