diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/IRC/Client.pm6 | 431 | ||||
| -rw-r--r-- | lib/IRC/Client.rakumod | 332 | ||||
| -rw-r--r-- | lib/IRC/Client/Core.rakumod | 155 | ||||
| -rw-r--r-- | lib/IRC/Client/Grammar.pm6 | 26 | ||||
| -rw-r--r-- | lib/IRC/Client/Grammar/Actions.pm6 | 119 | ||||
| -rw-r--r-- | lib/IRC/Client/Handler.rakumod | 174 | ||||
| -rw-r--r-- | lib/IRC/Client/Message.pm6 | 79 | ||||
| -rw-r--r-- | lib/IRC/Client/Message.rakumod | 180 | ||||
| -rw-r--r-- | lib/IRC/Client/Plugin.rakumod | 28 | ||||
| -rw-r--r-- | lib/IRC/Client/Server.pm6 | 20 |
10 files changed, 869 insertions, 675 deletions
diff --git a/lib/IRC/Client.pm6 b/lib/IRC/Client.pm6 deleted file mode 100644 index bd0d861..0000000 --- a/lib/IRC/Client.pm6 +++ /dev/null @@ -1,431 +0,0 @@ -unit class IRC::Client; - -use IO::Socket::Async::SSL; - -use IRC::Client::Message; -use IRC::Client::Grammar; -use IRC::Client::Server; -use IRC::Client::Grammar::Actions; - -my class IRC_FLAG_NEXT {}; - -role IRC::Client::Plugin is export { - my IRC_FLAG_NEXT $.NEXT; - has $.irc is rw; -} - -has @.filters where .all ~~ Callable; -has %.servers where .values.all ~~ IRC::Client::Server; -has @.plugins; -has $.debug; -has Lock $!lock = Lock.new; -has Channel $!event-pipe = Channel.new; -has Channel $!socket-pipe = Channel.new; -has Bool $.autoprefix = True; - -my &colored = (try require Terminal::ANSIColor) === Nil - && sub (Str $s, $) { $s } || - ::('Terminal::ANSIColor::EXPORT::DEFAULT::&colored'); -BEGIN $! = Nil; - $! = Nil; # don't serialize any exceptions from the above - -submethod BUILD ( - Int:D :$!debug = 0, - :$filters = (), - :$plugins = (), - :$servers = {}, - Int:D :$port where 0 <= $_ <= 65535 = 6667, - Str :$password, - Str:D :$host = 'localhost', - :$nick = ['P6Bot'], - :$alias = [], - Bool:D :$ssl = False, - Str :$ca-file, - Str:D :$username = 'Perl6IRC', - Str:D :$userhost = 'localhost', - Str:D :$userreal = 'Perl6 IRC Client', - :$channels = ('#perl6',), - Bool:D :$autoprefix = True, -) { - @!filters = @$filters; - @!plugins = @$plugins; - $!autoprefix = $autoprefix; - - my %servers = %$servers; - - my %all-conf = :$port, :$password, :$host, :$nick, :$alias, - :$username, :$userhost, :$userreal, :$channels, :$ssl, :$ca-file; - - %servers = '_' => {} unless %servers; - for %servers.keys -> $label { - my $conf = %servers{$label}; - my $s = IRC::Client::Server.new( - :socket(Nil), - :$label, - :channels( @($conf<channels> // %all-conf<channels>) ), - :nick[ |($conf<nick> // %all-conf<nick>) ], - :alias[ |($conf<alias> // %all-conf<alias>) ], - |%( - <host password port username userhost userreal ssl ca-file> - .map: { $_ => $conf{$_} // %all-conf{$_} } - ), - ); - # Automatically add nick__ variants if given just one nick - $s.nick[1..3] = "$s.nick()[0]_", "$s.nick()[0]__", "$s.nick()[0]___" - if $s.nick.elems == 1; - $s.current-nick = $s.nick[0]; - %!servers{$label} = $s; - } -} - -method join (*@channels, :$server) { - self.send-cmd: 'JOIN', ($_ ~~ Pair ?? .kv !! .Str), :$server - for @channels; - self; -} - -method nick (*@nicks, :$server = '*') { - @nicks[1..3] = "@nicks[0]_", "@nicks[0]__", "@nicks[0]___" if @nicks == 1; - self!set-server-attr($server, 'nick', @nicks); - self!set-server-attr($server, 'current-nick', @nicks[0]); - self.send-cmd: 'NICK', @nicks[0], :$server; - self; -} - -method part (*@channels, :$server) { - self.send-cmd: 'PART', $_, :$server for @channels; - self; -} - -method quit (:$server = '*') { - if $server eq '*' { .has-quit = True for %!servers.values; } - else { self!get-server($server).has-quit = True; } - self.send-cmd: 'QUIT', :$server; - self; -} - -method run { - .irc = self for @.plugins.grep: { .DEFINITE and .^can: 'irc' }; - start { - my $closed = $!event-pipe.closed; - loop { - if $!event-pipe.receive -> $e { - $!debug and debug-print $e, :in, :server($e.server); - $!lock.protect: { - self!handle-event: $e; - CATCH { default { warn $_; warn .backtrace } } - }; - } - elsif $closed { last } - } - CATCH { default { warn $_; warn .backtrace } } - } - - .irc-started for self!plugs-that-can('irc-started'); - self!connect-socket: $_ for %!servers.values; - loop { - my $s = $!socket-pipe.receive; - self!connect-socket: $s unless $s.has-quit; - unless %!servers.values.grep({!.has-quit}) { - $!debug and debug-print 'All servers quit by user. Exiting', :sys; - last; - } - } -} - -method send (:$where!, :$text!, :$server, :$notice) { - for $server || |%!servers.keys.sort { - if self!get-server($_).is-connected { - self.send-cmd: $notice ?? 'NOTICE' !! 'PRIVMSG', $where, $text, - :server($_); - } - else { - $!debug and debug-print( :out, :server($_), - '.send() called for an unconnected server. Skipping...' - ); - } - } - - self; -} - -############################################################################### -############################################################################### -############################################################################### -############################################################################### -############################################################################### -############################################################################### - -method !change-nick ($server) { - my $idx = 0; - for $server.nick.kv -> $i, $n { - next unless $n eq $server.current-nick; - $idx = $i + 1; - $idx = 0 if $idx == $server.nick.elems; - last; - }; - if $idx == 0 { - Promise.in(10).then: { - $server.current-nick = $server.nick[$idx]; - self.send-cmd: "NICK $server.current-nick()", :$server; - } - } - else { - $server.current-nick = $server.nick[$idx]; - self.send-cmd: "NICK $server.current-nick()", :$server; - } -} - -method !connect-socket ($server) { - $!debug and debug-print 'Attempting to connect to server', :out, :$server; - - my $socket; - - if ($server.ssl) { - $socket = IO::Socket::Async::SSL.connect($server.host, $server.port, ca-file => $server.ca-file); - } else { - $socket = IO::Socket::Async.connect($server.host, $server.port); - } - - $socket.then: sub ($prom) { - if $prom.status ~~ Broken { - $server.is-connected = False; - $!debug and debug-print "Could not connect: $prom.cause()", :out, :$server; - sleep 10; - $!socket-pipe.send: $server; - return; - } - - $server.socket = $prom.result; - - self!ssay: "PASS $server.password()", :$server - if $server.password.defined; - self!ssay: "NICK {$server.nick[0]}", :$server; - - self!ssay: :$server, join ' ', 'USER', $server.username, - $server.username, $server.host, ':' ~ $server.userreal; - - my $left-overs = ''; - react { - 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; - - (my $events, $left-overs) = self!parse: $str, :$server; - $!event-pipe.send: $_ for $events.grep: *.defined; - - CATCH { default { warn $_; warn .backtrace } } - } - } - - unless $server.has-quit { - $server.is-connected = False; - $!debug and debug-print "Connection closed", :in, :$server; - sleep 10; - } - - $!socket-pipe.send: $server; - CATCH { default { warn $_; warn .backtrace; } } - } -} - -method !handle-event ($e) { - my $s = %!servers{ $e.server }; - given $e.command { - when '001' { - $s.current-nick = $e.args[0]; - self.join: $s.channels, :server($s); - } - when 'PING' { return $e.reply; } - when '433'|'432' { self!change-nick: $s; } - } - - my $event-name = 'irc-' ~ $e.^name.subst('IRC::Client::Message::', '') - .lc.subst: '::', '-', :g; - - my @events = flat gather { - given $event-name { - when 'irc-privmsg-channel' | 'irc-notice-channel' { - my $nick = $s.current-nick; - my @aliases = $s.alias; - if $e.text ~~ s/^ [ $nick | @aliases ] <[,:]> \s*// { - take 'irc-addressed', ('irc-to-me' if $s.is-connected); - } - elsif $e.text ~~ / << [ $nick | @aliases ] >> / - and $s.is-connected - { - take 'irc-mentioned'; - } - take $event-name, $event-name eq 'irc-privmsg-channel' - ?? 'irc-privmsg' !! 'irc-notice'; - } - when 'irc-privmsg-me' { - take $event-name, ('irc-to-me' if $s.is-connected), - 'irc-privmsg'; - } - when 'irc-notice-me' { - take $event-name, ('irc-to-me' if $s.is-connected), - 'irc-notice'; - } - when 'irc-mode-channel' | 'irc-mode-me' { - take $event-name, 'irc-mode'; - } - when 'irc-numeric' { - if $e.command eq '001' { - $s.is-connected = True; - take 'irc-connected'; - } - - # prefix numerics with 'n' as irc-\d+ isn't a valid identifier - take 'irc-' ~ ('n' if $e ~~ IRC::Client::Message::Numeric) - ~ $e.command, $event-name; - } - default { take $event-name } - } - take 'irc-all'; - } - - EVENT: for @events -> $event { - debug-print "emitting `$event`", :sys - if $!debug >= 3 or ($!debug == 2 and not $event eq 'irc-all'); - - for self!plugs-that-can($event, $e) { - my $res is default(Nil) = ."$event"($e); - next if $res ~~ IRC_FLAG_NEXT; - - # Do not .reply with bogus return values - last EVENT if $res ~~ IRC::Client | Supply | Channel; - - if $res ~~ Promise { - $res.then: { - $e.?reply: $^r.result - unless $^r.result ~~ Nil or $e.?replied; - } - } else { - $e.?reply: $res unless $res ~~ Nil or $e.?replied; - } - last EVENT; - - CATCH { default { warn $_, .backtrace; } } - } - } -} - -method !parse (Str:D $str, :$server) { - return |IRC::Client::Grammar.parse( - $str, - :actions( IRC::Client::Grammar::Actions.new: :irc(self), :$server ) - ).made; -} - -method !plugs-that-can ($method, |c) { - gather { - for @!plugins -> $plug { - take $plug if .cando: \($plug, |c) - for $plug.^can: $method; - } - } -} - -method !get-server ($server is copy) { - $server //= '_'; # stupid Perl 6 and its sig defaults - return $server if $server ~~ IRC::Client::Server; - return %!servers{$server}; -} - -method send-cmd ($cmd, *@args is copy, :$prefix = '', :$server) { - if $cmd eq 'NOTICE'|'PRIVMSG' { - my ($where, $text) = @args; - if @!filters - and my @f = @!filters.grep({ - .signature.ACCEPTS: \($text) - or .signature.ACCEPTS: \($text, :$where) - }) - { - start { - CATCH { default { warn $_; warn .backtrace } } - for @f -> $f { - given $f.signature.params.elems { - when 1 { $text = $f($text); } - when 2 { ($text, $where) = $f($text, :$where); } - } - } - self!ssay: :$server, join ' ', $cmd, $where, ":$prefix$text"; - } - } - else { - self!ssay: :$server, join ' ', $cmd, $where, ":$prefix$text"; - } - } - else { - if @args { - my $last := @args[*-1]; - $last = ':' ~ $last - if not $last or $last.starts-with: ':' or $last.match: /\s/; - } - self!ssay: :$server, join ' ', $cmd, @args; - } -} - -method !set-server-attr ($server, $method, $what) { - if $server ne '*' { - %!servers{$server}."$method"() = $what ~~ List ?? @$what !! $what; - return; - } - - for %!servers.values { - ."$method"() = $what ~~ List ?? @$what !! $what ; - } -} - -method !ssay (Str:D $msg, :$server is copy) { - $server //= '*'; - $!debug and debug-print $msg, :out, :$server; - %!servers{$_}.socket.print: "$msg\n" - for |($server eq '*' ?? %!servers.keys.sort !! ~$server); - self; -} - -############################################################################### -############################################################################### -############################################################################### -############################################################################### -############################################################################### -############################################################################### - -sub debug-print ($str, :$in, :$out, :$sys, :$server) { - my $server-str = $server - ?? colored(~$server, 'bold white on_cyan') ~ ' ' !! ''; - - my @bits = ( - $str ~~ IRC::Client::Message::Privmsg|IRC::Client::Message::Notice - ?? ":$str.usermask() $str.command() $str.args()[]" - !! $str.Str - ).split: ' '; - - if $in { - my ($pref, $cmd) = 0, 1; - if @bits[0] eq '❚⚠❚' { - @bits[0] = colored @bits[0], 'bold white on_red'; - $pref++; $cmd++; - } - @bits[$pref] = colored @bits[$pref], 'bold magenta'; - @bits[$cmd] = (@bits[$cmd]//'') ~~ /^ <[0..9]>**3 $/ - ?? colored(@bits[$cmd]//'', 'bold red') - !! colored(@bits[$cmd]//'', 'bold yellow'); - put colored('▬▬▶ ', 'bold blue' ) ~ $server-str ~ @bits.join: ' '; - } - elsif $out { - @bits[0] = colored @bits[0], 'bold magenta'; - put colored('◀▬▬ ', 'bold green') ~ $server-str ~ @bits.join: ' '; - } - elsif $sys { - put colored(' ' x 4 ~ '↳', 'bold white') ~ ' ' - ~ @bits.join(' ') - .subst: /(\`<-[`]>+\`)/, { colored(~$0, 'bold cyan') }; - } - else { - die "Unknown debug print mode"; - } -} diff --git a/lib/IRC/Client.rakumod b/lib/IRC/Client.rakumod new file mode 100644 index 0000000..6df8de0 --- /dev/null +++ b/lib/IRC/Client.rakumod @@ -0,0 +1,332 @@ +#! /usr/bin/env false + +use v6.d; + +use Log; + +use IRC::Client::Core; +use IRC::Client::Handler; +use IRC::Client::Message; +use IRC::Client::Plugin; + +#| A simple IRC client, intended for automating interactions. +unit class IRC::Client; + +#| The host to connect to. +has Str $.host = '127.0.0.1'; + +#| The port to connect to. +has Int $.port = 6697; + +#| Use SSL. Requires IO::Socket::Async::SSL to be installed. +has Bool $.ssl = True; + +#| A list of channels to join on startup. +has Str @.channels is rw; + +#| A list of acceptable nicknames to use. +has Str @.nicks; + +#| The user to identify as. +has Str $.user = 'raku'; + +#| The real name to identify as. +has Str $.real-name = 'IRC::Client'; + +#| A list of plugins to use. +has IRC::Client::Plugin @.plugins; + +#| The timeout between liveness checks (a PING to itself). +has Real $.liveness-check-timeout = 30; + +#| The timeout between sending individual messages. +has Real $.send-timeout = 0.2; + +#| The bot's own full prefix. +has Str $.prefix is rw; + +#| The current nick of the bot. +has Str $.nick is rw; + +#| Whether the bot is already connected. +has Bool $.connected is rw; + +#| The connection with the IRC server. +has $!connection; + +#| A supplier for incoming messages. +has Supplier $!in; + +#| A Channel for outgoing messages. +has Channel $!out; + +submethod TWEAK +{ + # Due to lack of knowledge on how to properly do "protected" variables + # in Raku, I'm just throwing a lot of warnings when you shouldn't be + # setting something. + if ($!connected) { .warning("Don't set connected on .new!") with $Log::instance } + if ($!prefix) { .warning("Don't set prefix on .new!") with $Log::instance } + if ($!nick) { .warning("Don't set nick on .new!") with $Log::instance } + + $!connected = False; +} + +#| Start the IRC client, connecting to the server and signing on to the +#| network. +method start +{ + # Sanity checks + if (!@!nicks) { + .error("You must specify at least one nickname") with $Log::instance; + return; + } + + # Include the core functionality plugin + @!plugins.unshift(IRC::Client::Core.new); + + # Insert IRC::Client object into plugins + for @!plugins.grep(* ~~ IRC::Client::Plugin:D) { + $_.irc = self; + } + + # Set up suppliers + $!in = Supplier.new; + $!out = Channel.new; + + # Set up a tap to handle incomding messages, outside of the react + # block. This should help in keeping the react block free of + # long-running code. + $!in.Supply.tap(sub ($message) { + try { + CATCH { + default { + my $exception = $_ + .gist + .lines + .map(*.trim-trailing) + .join("\n") + ; + + .critical($exception) with $Log::instance; + } + } + + .debug("Handling $message") with $Log::instance; + IRC::Client::Handler.handle(IRC::Client::Message.new($message, self)); + } + }); + + # Dispatch an irc-started event. This event should occurr once per run, + # to perform certain initial setups like an HTTP server. + IRC::Client::Handler.dispatch(['irc-started' => self], self); + + # Pick the socket class + my $socket = !$!ssl ?? IO::Socket::Async !! do { + require ::('IO::Socket::Async::SSL'); + }; + + # Connect to the server in a loop, to ensure automatic re-connection + # upon any issue. + loop { + .debug("Connecting to $!host:$!port") with $Log::instance; + + try { + CATCH { + default { + my $exception = $_ + .gist + .lines + .map(*.trim-trailing) + .join("\n") + ; + + .emergency($exception) with $Log::instance; + } + } + + $!connection = await $socket.connect($!host, $!port); + .debug("Connected to $!host:$!port") with $Log::instance; + + # Create a buffer for incoming data + my $buffer; + + react { + # Setup handling incoming messages + whenever $!connection.Supply -> $message { + for $message.comb -> $character { + given ($character) { + # When \r\n is encountered, it signifies the end of a message, + # so emit whatever is in the $!buffer to the $!in Supply. + when "\r\n" { + .info("< $buffer") with $Log::instance; + $!in.emit($buffer); + $buffer = ''; + } + + # Otherwise, add the character to the $!buffer. + default { $buffer ~= $character } + } + } + } + + # Setup handling outgoing messages + whenever Supply.interval($!send-timeout) { + if ($!connected) { + with ($!out.poll) -> $message { + .notice("> $message") with $Log::instance; + $!connection.put($message); + } + } + } + + # Simple keep-alive check, to ensure the socket + # is still open and usable. + whenever Supply.interval($!liveness-check-timeout).skip { + if ($!connected) { + self.privmsg($!nick, "PING {now.to-posix.first.subst('.', ' ')}", :ctcp); + } + } + + # Setup handling ^c + whenever signal(SIGINT) { + .notice('Caught ^c') with $Log::instance; + self.stop('Caught ^c'); + exit 0; + } + + # Log on to the server + IRC::Client::Handler.dispatch(['irc-setup' => self], self); + + LAST { + $!connected = False; + .error('Socket closed') with $Log::instance; + } + } + } + + # Wait a small amount of time, in order to not blast an IRC + # server with connections when something is wrong. + sleep(5); + } +} + +#| Stop the IRC client, sending a QUIT to the server and closing the +#| connection. +method stop ( + Str:D $reason = '' +) { + my $message = "QUIT :$reason"; + + .notice("> $message") with $Log::instance; + + $!connected = False; + $!connection.put($message); + $!connection.close; +} + +# +# Backwards compatability +# + +method run ( +) is DEPRECATED('IRC::Client.start') { + self.start() +} + +method quit ( +) is DEPRECATED('IRC::Client.stop') { + self.stop() +} + +method send ( + :$where!, + :$text!, + :$notice +) is DEPRECATED('IRC::Client.privmsg or IRC::Client.notice') { + self."{$notice ?? 'notice' !! 'privmsg'}"($where, $text) +} + +# +# Barebones messaging +# + +#| Send a raw line to the IRC server. +method send-raw ( + Str:D $message, +) { + $!out.send($message); +} + +# +# Convenience methods +# + +method join ( + Str:D $channel, +) { + self.send-raw("JOIN $channel"); +} + +method set-nick ( + Str:D $nick, +) { + $!nick = $nick; + self.send-raw("NICK :$nick"); +} + +method part ( + Str:D $channel, +) { + self.send-raw("PART $channel"); +} + +multi method privmsg ( + Str:D $target, + Str:D $message, + Bool :$ctcp where { !$_ }, +) { + self.send-raw("PRIVMSG $target :$message"); +} + +multi method privmsg ( + Str:D $target, + Str:D $message, + Bool :$ctcp! where { $_ }, +) { + self.privmsg($target, "\x[1]$message\x[1]"); +} + +multi method notice ( + Str:D $target, + Str:D $message, + Bool :$ctcp where { !$_ }, +) { + self.send-raw("NOTICE $target :$message"); +} + +multi method notice ( + Str:D $target, + Str:D $message, + Bool :$ctcp where { $_ }, +) { + self.notice($target, "\x[1]$message\x[1]"); +} + +=begin pod + +=NAME IRC::Client +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/IRC/Client/Core.rakumod b/lib/IRC/Client/Core.rakumod new file mode 100644 index 0000000..8cba445 --- /dev/null +++ b/lib/IRC/Client/Core.rakumod @@ -0,0 +1,155 @@ +#! /usr/bin/env false + +use v6.d; + +use IRC::Client::Handler; +use IRC::Client::Plugin; +use Log; + +#| A plugin for IRC::Client, encapsulating all the core functionality required +#| of a functional IRC client. +unit class IRC::Client::Core is IRC::Client::Plugin; + +#| Special cased method to setup the initial connection with IRC. +multi method irc-setup ($irc) { + $irc.connected = True; + $irc.send-raw("USER {$irc.user} 8 * :{$irc.real-name}"); + $irc.set-nick($irc.nicks[0]); +} + +#| Special cased method to perform actions once the client is ready to go to +#| work. +multi method irc-ready ($irc) { + for $irc.channels -> $channel { + $irc.join($channel); + } +} + +#| Handle RPL_WELCOME. This message indicates that the connection setup has +#| been succesful. +multi method irc-n001 ($message) { + my $nick = $message.params[0]; + + .debug("Logged in as $nick") with $Log::instance; + + $.irc.prefix = $message[*-1].words.tail; + $.irc.nick = $nick; +} + +#| Handle ERR_ERRONEUSNICKNAME. This message indicates that the nickname which +#| is being used is not allowed, and the client should try an alternative +#| instead. +multi method irc-n432 ($message where { $_.params[0] eq '*' }) { + .error($message.params[*-1]) with $Log::instance; + + my @nicks = $.irc.nicks; + my $index = @nicks.first($.irc.nick, :k) + 1 // 0; + + if (@nicks.elems ≤ $index) { + .warning("No more nicks to try ({@nicks.join(' ')})") with $Log::instance; + $.irc.stop; + exit(3); + } + + $.irc.set-nick(@nicks[$index]); +} + +#| Handle ERR_NICKNAMEINUSE. This message indicates the nickname which is being +#| used is already in use by another client. Another nickname should be tried +#| instead. +multi method irc-n433 ($message where { $_.params[0] eq '*' }) { + self.irc-n432($message); +} + +multi method irc-n433 ($message where { $_.params[0] ne '*'}) { + $.irc.nick = $_.params[1]; +} + +#| Handle ERR_CHANNELISFULL. This message indicates a channel could not be +#| joined due to a user count limitation (+l). +multi method irc-n471 ($message) { + self!unregister-channel($.irc, $message.params[1]); +} + +#| Handle ERR_INVITEONLYCHAN. This message indicates a channel could not be +#| joined because you must be invited (+i). +multi method irc-n473 ($message) { + self!unregister-channel($message.params[1]); +} + +#| Handle ERR_BANNEDFROMCHAN. This message indicates a channel could not be +#| joined due to an active ban (+b). +multi method irc-n474 ($message) { + self!unregister-channel($message.params[1]); +} + +#| Handle ERR_BADCHANNELKEY. This message indicates a channel could not be +#| joined because it requires a key, or the given key was incorrect. +multi method irc-n475 ($message) { + self!unregister-channel($message.params[1]); +} + +#| Handle JOIN, but only if it pertains to ourselves. This method will keep the +#| IRC::Client.channels list synced to the channels the bot is actually in. +multi method irc-join ($message where { $_.nickname eq $message.irc.nick }) { + self!register-channel($message.params[0]); +} + +#| Handle PART, but only if it pertains to ourselves. This method will keep the +#| IRC::Client.channels list synced to the channels the bot is actually in. +multi method irc-part ($message where { $_.nickname eq $message.irc.nick }) { + self!unregister-channel($message.params[0]); +} + +#| Handle a CTCP PING request. +multi method irc-privmsg ($message where { $_.ctcp && $_.params[*-1].words[0] eq 'PING'}) { + $.irc.notice($message.nickname, "PING {$message.params[*-1].words[1..*]}", :ctcp); +} + +#| Handle a CTCP VERSION request. +multi method irc-privmsg ($message where { $_.ctcp && $_.params[*-1].words[0] eq 'VERSION'}) { + $.irc.notice($message.nickname, 'VERSION raku/IRC::Client v0.1.0', :ctcp); +} + +#| Handle a PING command. This message should be responded to with a PONG +#| reply, to indicate the client is still alive. +multi method irc-ping ($message) { + $.irc.send-raw("PONG :{$message.params[*-1]}"); +} + +#| Convenience method for adding a channel to the IRC::Client.channels list. +method !register-channel ($channel) { + my @channels = $.irc.channels; + + return if @channels ∋ $channel; + + .debug("Adding $channel to the IRC::Client.channels") with $Log::instance; + + $.irc.channels.append($channel); +} + +#| Convenience method for removing a channel from the IRC::Client.channels +#| list. +method !unregister-channel ($channel) { + .debug("Removing $channel from IRC::Client.channels") with $Log::instance; + + $.irc.channels = $.irc.channels.grep(* ne $channel); +} + +=begin pod + +=NAME IRC::Client::Core +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/IRC/Client/Grammar.pm6 b/lib/IRC/Client/Grammar.pm6 deleted file mode 100644 index 9afecc7..0000000 --- a/lib/IRC/Client/Grammar.pm6 +++ /dev/null @@ -1,26 +0,0 @@ -unit grammar IRC::Client::Grammar; -token TOP { <message>+ <left-overs> } -token left-overs { \N* } -token SPACE { ' '+ } -token message { [':' <prefix> <SPACE> ]? <command> <params> \n } - regex prefix { - [ <servername> || <nick> ['!' <user>]? ['@' <host>]? ] - <before <SPACE>> - } - token servername { <host> } - token nick { - # the RFC grammar states nicks have to start with a letter, - # however, modern server support and nick use disagrees with that - # and nicks can start with special chars too - [<letter> | <special>] [ <letter> | <number> | <special> ]* - } - token user { <-[\ \x[0]\r\n]>+? <before [<SPACE> | '@']>} - token host { <-[\s!@]>+ } - token command { <letter>+ | <number>**3 } - token params { <SPACE>* [ ':' <trailing> | <middle> <params> ]? } - token middle { <-[:\ \x[0]\r\n]> <-[\ \x[0]\r\n]>* } - token trailing { <-[\x[0]\r\n]>* } - - token letter { <[a..zA..Z]> } - token number { <[0..9]> } - token special { <[-_\[\]\\`^{}|]> } diff --git a/lib/IRC/Client/Grammar/Actions.pm6 b/lib/IRC/Client/Grammar/Actions.pm6 deleted file mode 100644 index b1fcc53..0000000 --- a/lib/IRC/Client/Grammar/Actions.pm6 +++ /dev/null @@ -1,119 +0,0 @@ -unit class IRC::Client::Grammar::Actions; - -use IRC::Client::Message; - -has $.irc; -has $.server; - -method TOP ($/) { - $/.make: ( - $<message>».made, - ~( $<left-overs> // '' ), - ); -} - -method message ($match) { - my %args; - my $pref = $match<prefix>; - for qw/nick user host/ { - $pref{$_}.defined or next; - %args<who>{$_} = ~$pref{$_}; - } - %args<who><host> = ~$pref<servername> if $pref<servername>.defined; - - my $p = $match<params>; - loop { - %args<params>.append: ~$p<middle> if $p<middle>.defined; - - if ( $p<trailing>.defined ) { - %args<params>.append: ~$p<trailing>; - last; - } - last unless $p<params>.defined; - $p = $p<params>; - } - - my %msg-args = - command => $match<command>.uc, - args => %args<params>, - host => %args<who><host>//'', - irc => $!irc, - nick => %args<who><nick>//'', - server => $!server, - usermask => ~($match<prefix>//''), - username => %args<who><user>//''; - - my $msg; - given %msg-args<command> { - when /^ <[0..9]>**3 $/ { - $msg = IRC::Client::Message::Numeric.new: |%msg-args; - } - when 'JOIN' { - $msg = IRC::Client::Message::Join.new: - :channel( %args<params>[0] ), - |%msg-args; - } - when 'PART' { - $msg = IRC::Client::Message::Part.new: - :channel( %args<params>[0] ), - |%msg-args; - } - when 'NICK' { - $msg = IRC::Client::Message::Nick.new: - :new-nick( %args<params>[0] ), - |%msg-args; - } - when 'NOTICE' { $msg = msg-notice %args, %msg-args } - when 'MODE' { $msg = msg-mode %args, %msg-args } - when 'PING' { $msg = IRC::Client::Message::Ping.new: |%msg-args } - when 'PRIVMSG' { $msg = msg-privmsg %args, %msg-args } - when 'QUIT' { $msg = IRC::Client::Message::Quit.new: |%msg-args } - default { $msg = IRC::Client::Message::Unknown.new: |%msg-args } - } - - $match.make: $msg; -} - -sub msg-privmsg (%args, %msg-args) { - %args<params>[0] ~~ /^<[#&]>/ - and return IRC::Client::Message::Privmsg::Channel.new: - :channel( %args<params>[0] ), - :text( %args<params>[1] ), - |%msg-args; - - return IRC::Client::Message::Privmsg::Me.new: - :text( %args<params>[1] ), - |%msg-args; -} - -sub msg-notice (%args, %msg-args) { - %args<params>[0] ~~ /^<[#&]>/ - and return IRC::Client::Message::Notice::Channel.new: - :channel( %args<params>[0] ), - :text( %args<params>[1] ), - |%msg-args; - - return IRC::Client::Message::Notice::Me.new: - :text( %args<params>[1] ), - |%msg-args; -} - -sub msg-mode (%args, %msg-args) { - if %args<params>[0] ~~ /^<[#&]>/ { - my @modes; - for %args<params>[1..*-1].join.comb: /\S/ { - state $sign; - /<[+-]>/ and $sign = $_ and next; - @modes.push: $sign => $_; - }; - return IRC::Client::Message::Mode::Channel.new: - :channel( %args<params>[0] ), - :modes( @modes ), - |%msg-args; - } - else { - return IRC::Client::Message::Mode::Me.new: - :modes( %args<params>[1..*-1].join.comb: /<[a..zA..Z]>/ ), - |%msg-args; - } -} diff --git a/lib/IRC/Client/Handler.rakumod b/lib/IRC/Client/Handler.rakumod new file mode 100644 index 0000000..c966099 --- /dev/null +++ b/lib/IRC/Client/Handler.rakumod @@ -0,0 +1,174 @@ +#! /usr/bin/env false + +use v6.d; + +use IRC::Client::Message; +use IRC::Client::Plugin; + +use Log; + +#| This class handles incoming messages, formats a context from them and +#| dispatches it on to any registered plugin that can handle it. +unit class IRC::Client::Handler; + +#| Handle numeric commands. +multi method handle ( + $event where { $_.command ~~ / \d ** 3/ }, +) { + my @events; + + # Special cases for IRC::Client + @events.append('irc-connected' => $event.irc) if $event.command eq '001'; + @events.append('irc-ready' => $event.irc) if $event.command eq '376'; + @events.append('irc-ready' => $event.irc) if $event.command eq '422'; + + # Regular events, handles in the regular way + @events.append("irc-n{$event.command}" => $event); + @events.append('irc-numeric' => $event); + @events.append('irc-all' => $event); + + self.dispatch(@events, $event.irc); +} + +#| Handle PRIVMSG and NOTICE commands. +multi method handle ( + $event where { $_.command ∈ <PRIVMSG NOTICE> } +) { + my @events; + my $stripped; + + # If the message starts with the name of the client, it should dispatch + # an irc-addressed event. + if ($event.params[*-1] ~~ / ^ ( "{$event.irc.nick}" <[:;,]> <.ws> ) /) { + $stripped = $event.set-param(*-1, $event.params[*-1].substr($0.chars)); + } + + + # A private message to the client should dispatch an irc-to-me event, + # optionally stripping away the client's current nickname from the + # start. + if ($event.params[0] eq $event.irc.nick) { + @events.append('irc-to-me' => $stripped // $event); + } + + # A message to a public channel prefixed with the client's current + # nickname is both an irc-to-me event, and an irc-addressed event. + if ($event.params[0] ne $event.irc.nick && $stripped) { + @events.append('irc-to-me' => $stripped); + @events.append('irc-addressed' => $stripped); + } + + @events.append("irc-{$event.command.fc}-me" => $event) if $event.params[0] eq $event.irc.nick; + @events.append('irc-mentioned' => $event) if $event.params[*-1].words ∋ $event.irc.nick; + @events.append("irc-{$event.command.fc}-channel" => $event) if $event.params[0] ~~ / ^ <[#&]> /; + @events.append("irc-{$event.command.fc}" => $event); + @events.append('irc-all' => $event); + + self.dispatch(@events, $event.irc); +} + +#| Handle MODE commands. +multi method handle ( + $event where { $_.command eq 'MODE' } +) { + my @events; + + @events.append('irc-mode-me' => $event) if $event.params[0] eq $event.irc.nick; + @events.append('irc-mode-channel' => $event) if $event.params[0] ~~ / ^ <[#&]> /; + @events.append('irc-mode' => $event); + @events.append('irc-all' => $event); + + self.dispatch(@events, $event.irc); +} + +#| Handle all IRC commands. Note that the order in which events are appended +#| does matter, the most "narrow" event should always come first, getting +#| broader as we go down the list. +multi method handle ( + $event, +) { + my @events; + + @events.append("irc-{$event.command.fc}" => $event); + @events.append('irc-all' => $event); + + self.dispatch(@events, $event.irc); +} + +#| Dispatch the message to all plugins. +method dispatch ( + @events, + $client, #= IRC::Client, but can't `use` this due to circular references +) { + my @plugins = $client.plugins; + + # Loop over all the plugins, and dispatch to each of them on a seperate + # thread. This allows plugins to take their sweet time, while not being + # in any other plugins' way. + for $client.plugins -> $plugin { + start { + CATCH { + default { + my $exception = $_; + .emergency($exception.gist.lines.map(*.trim-trailing).join("\n")) with $Log::instance; + } + } + + self.dispatch-plugin(@events, $plugin) + } + } +} + +#| Dispatch the message to all plugin methods that can handle them. +method dispatch-plugin ( + @events, + IRC::Client::Plugin $plugin, +) { + for @events -> $event { + my $method = $event.key; + my $payload = $event.value; + + # Check for available methods to handle this payload. + my @methods = $plugin.^can($method) + .map(*.candidates) + .flat + .grep(*.cando(\($plugin, $payload))) + ; + + # Nothing to do if nothing was found. + next unless @methods; + + .debug("Dispatching to {$plugin.^name}.$method") with $Log::instance; + + my $response = $plugin."$method"($payload); + + next unless $payload ~~ IRC::Client::Message; + + # Depending on the return value of the method, something can be + # done. + given ($response) { + when Str { + $payload.reply($response); + last; + } + } + } +} + +=begin pod + +=NAME IRC::Client::Handler +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/IRC/Client/Message.pm6 b/lib/IRC/Client/Message.pm6 deleted file mode 100644 index ff307ef..0000000 --- a/lib/IRC/Client/Message.pm6 +++ /dev/null @@ -1,79 +0,0 @@ -unit package IRC::Client::Message; - -role IRC::Client::Message { - has $.irc is required; - has Str:D $.nick is required; - has Str:D $.username is required; - has Str:D $.host is required; - has Str:D $.usermask is required; - has Str:D $.command is required; - has $.server is required; - has $.args is required; - - method Str { ":$!usermask $!command $!args[]" } -} - -constant M = IRC::Client::Message; - -role Join does M { has $.channel; } -role Mode does M { has @.modes; } -role Mode::Channel does Mode { has $.channel; } -role Mode::Me does Mode { } -role Nick does M { has $.new-nick; } -role Numeric does M { } -role Part does M { has $.channel; } -role Quit does M { } -role Unknown does M { - method Str { "❚⚠❚ :$.usermask $.command $.args[]" } -} - -role Ping does M { - method reply { $.irc.send-cmd: 'PONG', $.args, :$.server; } -} - -role Privmsg does M { - has $.text is rw; - has Bool $.replied is rw = False; - method Str { $.text } - method match ($v) { $.text ~~ $v } -} -role Privmsg::Channel does Privmsg { - has $.channel; - method reply ($text, :$where) { - $.irc.autoprefix - ?? $.irc.send-cmd: 'PRIVMSG', $where // $.channel, $text, :$.server, :prefix("$.nick, ") - !! $.irc.send-cmd: 'PRIVMSG', $where // $.channel, $text, :$.server - ; - } -} -role Privmsg::Me does Privmsg { - method reply ($text, :$where) { - $.irc.send-cmd: 'PRIVMSG', $where // $.nick, $text, - :$.server; - } -} - -role Notice does M { - has $.text is rw; - has Bool $.replied is rw = False; - method Str { $.text } - method match ($v) { $.text ~~ $v } -} -role Notice::Channel does Notice { - has $.channel; - method reply ($text, :$where) { - $.irc.autoprefix - ?? $.irc.send-cmd: 'NOTICE', $where // $.channel, $text, :$.server, :prefix("$.nick, ") - !! $.irc.send-cmd: 'NOTICE', $where // $.channel, $text, :$.server - ; - - $.replied = True; - } -} -role Notice::Me does Notice { - method reply ($text, :$where) { - $.irc.send-cmd: 'NOTICE', $where // $.nick, $text, - :$.server; - $.replied = True; - } -} diff --git a/lib/IRC/Client/Message.rakumod b/lib/IRC/Client/Message.rakumod new file mode 100644 index 0000000..1e1ffb7 --- /dev/null +++ b/lib/IRC/Client/Message.rakumod @@ -0,0 +1,180 @@ +#! /usr/bin/env false + +use v6.d; + +use IRC::Grammar; + +#| A class to represent a message over IRC. +unit class IRC::Client::Message; + +has Str $.servername; +has Str $.nickname; +has Str $.user; +has Str $.host; +has Str $.command; +has Str @.params; +has Bool $.ctcp = False; +has $.irc; + +multi method new ( + #| A string representing a line sent or received from an IRC server. + Str:D $line, + + #| A reference the the IRC::Client handling the message. + $irc, +) { + my $match = IRC::Grammar.parse($line); + + # If the line doesn't match the IRC grammar, it's malformed and not up + # to IRC::Client to fix it. + die "Malformed message '$line'" if !?$match; + + my $ctcp = False; + my @params = $match<params>.map(*.Str).Array; + + my %prefix = $match<prefix> + .hash + .kv + .map(sub ($key, $value) { $key => $value.Str }) + ; + + if ($match<command> eq 'PRIVMSG'|'NOTICE') { + with ($match<params>.tail.Str) { + if ($_.comb[0, *-1].grep(* eq "\x[1]")) { + $ctcp = True; + @params[*-1] = $_.Str.substr(1, *-1); + } else { + @params[*-1] = $_.Str; + } + } + } + + self.bless( + command => $match<command>.Str, + |%prefix, + :@params, + :$irc, + ); +} + +multi method new ( + %params, +) { + self.bless(|%params, params => %params<params>.list); +} + +method gist +{ + @!params.tail +} + +method prefix +{ + return $!servername if $!servername; + + my $prefix = $!nickname; + + if ($!host) { + if ($!user) { + $prefix = "$prefix!$!user"; + } + + $prefix = "$prefix@$!host"; + } + + $prefix; +} + +method raku +{ + my $s = "$!command {@!params.join(' ')}"; + + with (self.prefix) { $s = ":$_ $s" } + + given (@!params.elems) { + when 1 { + $s = "$s :{@!params[0]}" + } + default { + my @middle = @!params.head(*-1); + my $trailing = @!params.tail; + + $s = "$s {@middle.join(' ')} :$trailing"; + } + } + + + $s; +} + +method words +{ + self.Str.words +} + +method Hash +{ + %( + :$!servername, + :$!nickname, + :$!user, + :$!host, + :$!command, + :@!params, + :$!ctcp, + :$!irc, + ) +} + +method Str +{ + self.gist +} + +# +# Mutators +# + +method set-param ( + $index where { $_ ~~ Int:D|Code:D }, + Str:D $value, +) { + my %params = self.Hash; + + %params<params>[$index] = $value; + + self.new(|%params, params => %params<params>.list); +} + +# +# Convenience +# + +method reply ( + Str:D $message, +) { + my $target = @!params[0] eq $!irc.nick ?? $!nickname !! @!params[0]; + + given ($!command) { + when 'PRIVMSG' { $!irc.privmsg($target, $message, :$!ctcp) } + when 'NOTICE' { $!irc.notice($target, $message, :$!ctcp) } + } +} + +=begin pod + +=NAME IRC::Client::Message +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/IRC/Client/Plugin.rakumod b/lib/IRC/Client/Plugin.rakumod new file mode 100644 index 0000000..7388416 --- /dev/null +++ b/lib/IRC/Client/Plugin.rakumod @@ -0,0 +1,28 @@ +#! /usr/bin/env false + +use v6.d; + +#| A base role for IRC::Client plugins. A plugin may handle any number of +#| methods, in order to act upon events encountered by the client. +unit role IRC::Client::Plugin; + +#| A reference to the IRC::Client the plugin is used by. +has $.irc is rw; + +=begin pod + +=NAME IRC::Client::Plugin +=AUTHOR Patrick Spek <~tyil/raku-devel@lists.sr.ht> +=VERSION 0.0.0 + +=head1 Synopsis + +=head1 Description + +=head1 Examples + +=head1 See also + +=end pod + +# vim: ft=perl6 noet diff --git a/lib/IRC/Client/Server.pm6 b/lib/IRC/Client/Server.pm6 deleted file mode 100644 index 18f7755..0000000 --- a/lib/IRC/Client/Server.pm6 +++ /dev/null @@ -1,20 +0,0 @@ -unit class IRC::Client::Server; - -has @.channels where .all ~~ Str|Pair; -has @.nick where .all ~~ Str; -has @.alias where .all ~~ Str|Regex; -has Int $.port where 0 <= $_ <= 65535; -has Bool $.ssl = False; -has Str $.ca-file; -has Str $.label; -has Str $.host; -has Str $.password; -has Str $.username; -has Str $.userhost; -has Str $.userreal; -has Str $.current-nick is rw; -has Bool $.is-connected is rw; -has Bool $.has-quit is rw; -has $.socket is rw; - -method Str { $!label } |